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Abstract 

The implementation of the compiler of the UPLNC language is presented with a full source 
code listing. 

1 Introduction 

1.1 Why develop another language? 

There were several motivations to develop the UPLNC language. One of them was to make a 
programming language which suits better one's personal tastes, and allows experimenting with 
ideas. Also, developing of the compiler was an amusing process for the author, who hopes that 
this work will be instructive to the reader. From a certain point, one could view such a work as a 
work of art, like a poet would write a beautiful poem. Another reason behind this language would 
be the beginning of a much larger project- building an alternative do-it-yourself (DIY) platform, 
including programming language, developer tools, operating system kernel written in that language, 
full set of system and application utilities. If some day such a project becomes implemented, it is 
the author's hope that it will remain free, as free speech, without being threatened by claims of 
exclusive rights to use, modify and distribute. That's why the source code in the present work is 
released under the GNU General Public License. 

This language is already quite developed- the compiler does support unlimited level of indi- 
rection, multiple dimensional arrays, structures, methods of structures, and most of the control 
statements inherent of C. On the other hand, there are some more or less essential things which 
would be desirable to be implemented, e.g. floating point support, initializers and optimization 
phase before the code generation. 

An open question is whether this language will evolve as a general-purpose one like C and 
C-I--I-, or will have some more sophisticated features as combinatoric control statements(CCS). An 
lyrical diversion which gives some notion of CCS is a calculation of the form 

R= f{ii,i2,...,ik). (1) 

l<ii<i2<...<ifc<JV 

When k (the number of indices) is not known, the simplest way is to write some recursive or 
iterative algorithm which cycles the k indices in the appropriate way. This can be done also with a 
standard library function/template. A non-trivial way to deal with this situation is post-compile 
code generation: the program can generate machine code corresponding to something like 
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f or (i [k-1] =1 ; i [k-1] <=N; ++i [k-1] ) 
f or (i [k-2] =1 ; i [k-2] <=i [k-1] ; ++i [k-2] ) 
f or (i [k-3] =1 ; i [k-3] <=i [k-2] ; ++i [k-3] ) 

R+=f (i) ; 

and run that machine code, or it can output the source code to a file, invoke an external compiler 
which would produce a shared object, which then would be loaded and run. 

1.2 Development 

In part, this work was inspired by Small C compiler ^ and its variant RatC [H]. When the author 
encountered RatC around one decade ago, he made a rough implementation(or translation) of it in 
Turbo Pascal. That project was ultimately abandoned, mainly because it was a compiler written 
in a quite high-level language, translating(by design) a rather primitive language, so a bootstrap 
procedure was not possible. Its source code is probably lost. 

Much later, when I saw several other implementations of Small C, decided that it would be 
better, instead of making subsets and dialects, which will probably never be as good as the complete 
language, to make one's own language, referred to as UPLNC, which will allow more choices of its 
design. Still, I decided to use Small C as the first language to implement the UPLNC compiler- 
to that end I ported a version of Small C to i386-linux |^. Those preliminary versions of the 
compiler were pretty much constrained by the paradigms of the Small C compiler- no use of 
structures at all, so that tables were implemented by means of several arrays, corresponding to the 
different fields of the missing structures. Even in the present version one can find similarities of 
the syntax parser of UPLNC to the one of Small C, as well as artefacts of code borrowed from the 
Small C compiler. Nevertheless, the author wanted to escape the constraints of Small C, that's 
why, when the compiler was already able to produce correct code, the author wrote a utility for 
translating Small C to UPLNC (one can see its traces by some truncated identifiers like express!). 
The result was a compiler for UPLNC, written in the same language, so it could compile itself. 

A next step was to replace the implementation of the tables as arrays of scalar types with arrays 
or lists of structures. The processing of expressions was completely rewritten. The old Small C- 
style approach of code generation being done while parsing, was replaced by a three-stage process: 
parsing and building a tree, generating from that three an intermediate representation of the 
program code, producing of assembly code. It is possible in the future to include an optimization 
stage after the second stage of this process. 

Later, methods of structures were introduced in the language, much similar to the methods in 
C-f-|-: the method has a default parameter this which points to the instance of the structure, and 
within the method the members of the structure are visible. 

It is possible to declare variables in different styles: 

var a,b, c : [3] *char ; 

var [3] *char :d,e,f ; 

var extern al,a2:int; 

var extern int:a3; 

var int extern :a4; 

var a5: extern int; 

var a6 : int extern; 

var extern a7: extern int extern; 

var extern **int extern: extern aS; 

Currently, the only supported target of the compiler is Linux on i386-compatible processors. 
The code generated is link-compatible with C, that's why it is possible to link programs with 
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the GNU C library glibc, which is used by the compiler itself. It is plausible that with small 
modifications the compiler could support other operating systems running on i386-compatible mi- 
croprocessors. In order to support other architectures, it is possible to rewrite the code generating 
part of the compiler. This was the main reason behind separating the code generation in a different 
stage and even in the different module codegen.e. 
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Figure 1 : Scheme of grph . e 

A feature introduced in the compiler was the possibility of redefining certain syntax elements. 
An illustrative, albeit not quite readable example is this program for calculating of primes: 

"/."/.takeoff Icomp "<font>" ; 
ntakeoff rcomp "</font>" ; 
ntakeoff tfunc "<p>" ; 
y.y.takeoff larg "<arg>" ; 
"/."/takeoff rarg "$</arg>" ; 

#define MAXNUM 1000 
#define TABSZ 1001 

var tab: [TABSZ] int ; /*factorizes?*/ 

<p> doprimes<arg>$</arg> 
<f ont> 

var int : i , k ; 

printf <arg>"Calculating the primes>=3. . .\n"$</arg>; 
f or<arg>i=2; KTABSZ; i++$</arg> 

tab[i]=0; 
for<arg>i=3; KTABSZ; i=i+2$</arg> 
<font> 

if <arg>tab [i] $</arg> 

continue ; 
printf <arg>""/d\n" ,i$</arg>; 
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f or<arg>k=i ; k<TABSZ ; k=k+i$</arg> 
<f ont> 

tab[k]=l; 
</f oiit> 
</f ont> 
</f ont> 

<p> main<arg>$</arg> 
<f ont> 

doprimes<arg>$</ arg> ; 
</f oiit> 
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Figure 2: Scheme of langc.e 

Another feature which was implemented lately was the code graphing, namely producing a 
gnuplot IS] input file containing a graphical scheme of the referrals between global symbol names 
in a particular module. For example, the scheme produced for some of the modules in the compiler 
are shown in Fig^and FigI21 

The compiler driver was written in Perl 8 . It runs the preprocessor Ippl and redirects its 
output as input of the compiler langc. Linking is done by using the driver of gcc [7]. 

2 Source 

In this section a full source code listing of the compiler is presented. An archive of previous versions 
is in 
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2.1 langc.e 

/* -*- c -*- */ 

/* The language compiler by E.V., (C) 2003 */ 

/* 

This program is free software; you Ceiii redistribute it and/or modify 
it under the terms of the GNU General Public License as published by 
the Free Software Foimdation; either version 2 of the License, or 
(at your option) ciny later version. 

This program is distributed in the hope that it will be useful, 
but WITHOUT ANY WARRANTY; without even the implied warranty of 
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 
GNU General Public License for more details. 

You should have received a copy of the GNU General Public License 

along with this program; if not, write to the Free Software 

Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 

*/ 

#include "tlangc.he" 
#include "codegen.he" 



var errcnt : int ; 

var ncmp : int ; 

var nf unc : int ; 

var nvars : int ; 

var laststrint; 

var argstk : int ; 

var argtop : int ; 

var Zsp:int; 

method snamenode . done ( ) 

{ 

if (next) 
i 

next->done() ; 
free (next) ; 

} 

} 

method snamenode . init ( ) {next=0 ; name [0] =0 ; } 

method snamelist . dumpO 

{ 

var *snamenode : p ; 

f or (p=lst ;p;p=p->next) 

i 

fprintf (stderr , "%s\n" ,p->name) ; 

> 

} 

method snamelist . addm(*char : s) / *add (merge) */ 
{ 
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if ( ! this) return; 
var *sncmienode:p; 
if (p=find(s)) 
return ; 

chkmem(*f ront=calloc (1 , sizeof (snamenode) ) ) ; 
(*front)->init() ; 

strncpy ( (*f ront) ->name , s , NAMESIZE) ; 
f ront=&(*f ront)->next ; 

} 

method snamelist.find(*char:s) 
{ 

var * snamenode : p ; 

f or(p=lst ;p;p=p->next) 

if (strid(p->naine,s)) 

return p; 
return 0; 

} 

method snamelist . init () ■Clst=0 ; f ront=&lst ; } 

method snamelist .done () 

{ 

f ront=&lst ; 
if (1st) 
lst->done() ; 

} 

var *snamelist :cnmlst; 
method ssym.initO 
{ 

chkmem(ninlst=calloc (1 , sizeof (snamelist) ) ) ; 
ninlst->init() ; 

} 

method ssym.doneO 

{ 

if (nmlst) 
i 

nmlst->done() ; 
free (nmlst) ; 

> 

} 

var glbsymtab.locsymtabrssjrmtab; 
func ss3mitabinit(p:*ssymtab) 
{ 

p->lst=0; 

p->f ront=&p->lst ; 

} 

func ssymtaballoc(p:*ssymtab) 
{ 

var *ssym:res; 

(*p->f ront) =chkmem(calloc (1 , sizeof (ssymlist) ) ) ; 
(*p->f ront) ->next=0 ; 
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res=&(*p->front)->sym; 

p->f ront=&(*p->front)->next ; 

return res; 

} 

f unc ssjraitabf ind(p : *ssyintab,name : *char) 
{ 

var *ss3milist :q; 

for (q=p->lst ; q; q=q->next) 

i 

if (stridCname , q->sym . name) ) 
return &q->sym; 

} 

return 0; 

} 

func f indglb(name : *cheir) 
{ 

return ssymtabf indC&glbsymtab.name) ; 

} 

func f indloc(ncime:*char) 
{ 

return ssymtabf indC&locsymtab, name) ; 

} 

func ssjmitabaddCp : *ssymtab , sname : *char , sort : int , df d : int , offset : int , type : int) 
{ 

var *ssym:sym; 
sym=ssymtaballoc(p) ; 
sym->init () ; 
sym->sort=sort ; 
sym->df d=df d; 
sym->of f set=of f set ; 
sym->type=type ; 
St rcp(sym->name, sname) ; 
return sym; 

} 

func addloc (sname : *char , sort : int , df d : int , offset : int , type : int) 
{ 

return ssymtabaddC&locsjmtab, sname, sort, dfd, off set, type) ; 

} 

var extern cline:int; 

func addglb (sname : *char , sort : int , df d : int , offset : int , type : int) 
{ 

var *ssyiii:res; 

res=ssymtabadd (feglbsymtab , sname , sort , df d , offset , type) ; 
res->line=cline ; 
return res; 

} 

func ssjmitabcut (p: *ssymtab,w:**ssymlist) 
{ 

var *ss3railist:i,n; 
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for(i=*w;i;i=n) 
i 

n=i->rLext ; 
freed) ; 

> 

*w=0; 

p->front=w; 

> 

func ssymtabf ree(p: *ssymtab) 
{ 

var *ssymlist:q; 
var *ssymlist:t; 
f or (q=p->lst ; q; q=t) 
i 

t=q->next ; 
q->syin.done() ; 
free(q) ; 

> 

p->lst=0; 

p->f ront=&p->lst ; 

} 

func ssymtabf indsymCsjraitab : *ssyintab , sname : *chcir) 
{ 

var *ssymlist :p; 

f or(p=syintab->lst;p;p=p->next) 

if (stridCsname ,p->syin.naiiie) ) 

return p; 
return 0; 

> 

var typtab: *styp; 
var numtyp : int ; 

/*var typnames: [TYPNMTBS] char;*/ 

/*var typsort : [NUMTYP] int ; */ 

/*var typtype : [NUMTYP] int ; */ 

/*var typdim: [NUMTYP] int; */ 

/*var typsize: [NUMTYP] int;*/ 

var typptr : int ; 

var nmstrele : int ; 

var f ieldtab: *sf ield; 

/*var strnames : [STRNMTBS] char ; */ 

/*var strtyp : [NMSTRELE] int ; */ 

/*var stroffse: [NMSTRELE] int;*/ 

/*var strnext : [NMSTRELE] int ; */ 

var strptr : int ; 

var tolitstk: int ; 

var litstk: [litstksz] char ; 

var litstk2 : [litstksz] char ; 

var litstkle : [litstknu] int ; 

var litstkpt: [litstknu] int; 
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var line : [linesize] char ; 

var cline : int ; 

var mline : [linesize] char ; 

var Iptr : int ; 

var mptr : int ; 

var nextlab:int; 

func getlabelO 

{ 

return ++nextlab; 

} 

var stlab:int; 
var stptr : int ; 
var litq: [STSIZE] char; 
var wqsym : [WQNUM] int ; 
var wqsp : [WQNUM] int ; 
var wqloop : [WQNUM] int ; 
var wqlab: [WQNUM] int; 
var wqptr : int ; 



func putlitst(c:char) 
{ 

if (litstkpt [tolitstk] +litstkle [tolitstk] >=litstksz-l) { 
errorC'too leirge code from function arguments"); 
return 0; 
> 

litstk [litstkpt [tolitstk] +litstkle [tolitstk] ] =c ; 
litstkle [tolitstk] =litstkle [tolitstk] +1 ; 
return c; 

} 

func getlitstO 
{ 

if (tolitstk>=litstknu-l) { 

errorC'too meiny function arguments"); 

return 0; 

> 

++tolitstk; 

litstkle [tolitstk] =0 ; 

litstkpt [tolitstk] =litstkpt [tolitstk-1] +litstkle [tolitstk-1] ; 
return tolitstk; 

} 

func dumpltst(tl:int) 
{ 

var int : i ; 
var int : p ; 
var *char:q; 
var *char:pp; 
q=litstk2; 
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while (tolitstk>=tl) { 
i=litstkle [tolitstk] ; 
p=litstkpt [tolitstk] ; 
while (i—)-[ 

*q++=litstk[p++] ; 

> 

tolitstk — ; 
} 

pp=q; 

q=litstk2 ; 
while (q<pp) { 
outbyte(*q) ; 
++q; 
} 

} 

var iseof:int; 
var isinp:int; 
var quote : [2] char ; 
var tlcomp: [NAMESIZE] char; 
var trcomp: [NAMESIZE] char; 
var tlarg: [NAMESIZE] char; 
var trarg: [NAMESIZE] char; 
var tlsub: [NAMESIZE] char; 
var trsub: [NAMESIZE] char; 
var tfunc: [NAMESIZE] char; 
func inittokeO 
{ 

strcpCtlcomp, "{") ; 
strep (trcomp ,"}"); 
strcp(tlarg,"(") ; 
strep (trarg, ") ") ; 
strep (tlsub, " [") ; 
strep (trsub, "] ") ; 
strep (tfunc, "func") ; 

> 

func dotakeofO 
{ 

var *char: token; 
var int:k,c; 

if (amat eh ( " leomp" , 5) ) token=tleoinp ; 
else if (ajnateh("reomp" ,5))token=trcomp; 
else if (amateh("larg" ,4) )token=tlarg; 
else if (ainateh("rarg" ,4))token=trarg; 
else if (cimatch("lsub" ,4) )token=tlsub ; 
else if (amateh("rsub" ,4) )token=trsub; 
else if (ainateh("tfune" ,5))token=tfunc; 
else 
i 

error ("token name expected"); 
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return ; 

> 

blanks ; 

if (ch() ! = "") 

{errorC'qstr expected") ;return;} 

gchO ; 

k=0; 

while (ch() ! = "") 
i 

if (!ch())break; 

c=gcli() ; 
if (c==92) 
{ 

c=gch() ; 

if ( ! c) break; 

if (c=='n')c=10; 

else if (c=='t')c=9; 

else if (c=='b')c=8; 

else if (c=='f ')c=12; 

> 

if (k<NAMEMAX) 
token [k++]=c; 

} 

if (ch()=="")gch(); 
token [k] =0; 

comment () ;outstr("new token: ") ;outstr (token) ;nl() ; 
ns() ; 

} 

var int:tomap; 

var *char :mapname; 

var int:tograph; 

var *char :graphname; 

f unc parseopt (argc : int ,argv: **ch.ar) 

{ 

tomap=0 ; 

mapname="tlmap .map" ; 
tograph=0; 

graphncime=" tlgraph.dat" ; 

/*f printf (stderr , "parseopt \n" ) ; */ 

var int : i ; 

f or (i=l ; i<argc ; i++) 

i 

if (*argv[i] =='-') 
{ 

f printf (stderr, "option: \n") ; 
var k : int ; 

f or(k=l ;argv[i] [k] ;k++) 
if (argv[i] [k]=='m') 
{ 
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tomap=l ; 

if (argv[i] [k+1] =='-') 

{tomap=0;k++;} 
fprintf (stderr , " tomap=%d\n" ,tomap) ; 
} 

else if (argv[i] [k]=='g') 
{ 

tograph=l ; 

if (argv[i] [k+1] =='-') 

{tograph=0;k++;} 
fprintf (stderr, " tograph=°/.d\n" .tograph) ; 
> 

else if(argv[i] [k]=='M') 
{ 

if (argvCi] [k+1]) 
{ 

mapname=argv [i] +k+l ; 
while (argv[i] [k])++k; 
} 

else if(i>=argc-l) 
{ 

fprintf (stderr, "needs more argiiments\n") 
} 

else 
{ 

mapname=argv [++i] ; 
} 

fprintf (stderr, " inapnaine=7.s\n" ,mapnaiiie) ; 

} 

else if (argv[i] [k]=='G') 
i 

if (argv[i] [k+1]) 
{ 

graplinaiiie=argv [i] +k+l ; 
while (argv[i] [k])++k; 
} 

else if (i>=argc-l) 

fprintf (stderr , "needs more arguments\n") 
} 

else 
{ 

mapname=argv [++i] ; 

} 

fprintf (stderr, " graphname=yos\n" ,graphname 
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var methodcls : int ; /*whether we are in a method*/ 

var methodidx : int ; 

/*var methodths:*ssyiii;*/ 

/*var methodstr:int;*//*it's a type!*/ 

func main (argc: int, argv:**char) 

{ 

tolitstk=litstkpt [0] =litstkle [0] =ncmp=lastst=nextlab= 

lptr=iseof =strptr=stptr=errcnt=argstk=wqptr=line [0] =quote [1] =0 ; 

nf unc=0 ; nvars=0 ; cline=0 ; 

typptr=F_TYPE; 

strptr++; 

isinp=l ; 

cnmlst=0; 

/*glbptr++;*/ 

*quote="' ' ; 

methodcls=0 ; methodidx=0 ; / *methodstr=0 ; */ 

initdynO ; 

var *char :pp,pp2;pp=autodynstr("Hello ") ;pp2=autodynstr ("world\n") ; 

stlab=getlabel() ; 

parseopt (argc , argv) ; 

initsymsO ; 

inittokeO ; 

inittypes ; 

initf ieldsO ; 

initstO ; 

icodegenO ; 

header ; 

parse () ; 

dumplits ; 

dumpglbs () ; 

if (tomap) 

printmapO ; 

if (tograph) 

pr int graph () ; 

trailer ; 

dcodegenO ; 

err or sum () ; 

f reef ields () ; 

f reetypesO ; 

freesymsO ; 

/*fprintf (stderr,"(7.d) (7.d)%s7.s" ,pp,pp2,pp,pp2) ;*/ 
donedynO ; 
return 0; 

> 

func initsjrmsO 
{ 

ssymtabinit (feglbsymtab) ; 
ssymtabinit (felocsyTntab) ; 
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func freesymsO 
{ 

ssymtabf ree(&locsymtab) ; 
ssymtabfreeC&glbsymtab) ; 

} 

func chkmemCp : *int) 
{ 

/*fpriiitf (stderr , "chkmem(%d) \n" ,p) ; */ 

if (!p) 

i 

errorC'out of memory"); 
exit (2) ; 

} 

else 

return p; 

} 

func errorsumO 
{ 

if (ncmp) error ("missing '}'"); 

comment () ; 

outstrC" "); 

outdec(errcnt) ; 

outstrC" error(s)"); 

nlO; 

comment () ; 

outstrC" "); 

outdec(nfunc) ; 

outstrC" functionCs) , "); 

outdecCnvars) ; outstrC" global variables"); 

nlC); 

} 

func header C) 
{ 

comment C) ; 

outstrC"The Test Compiler"); 
nlC); 

} 

func parse C) 
{ 

while C ! iseof ) 
i 

if CmatchC"#def ine"))addmacC) ; 
else if CamatchC"%%takeoff ",9)) 

■C 

comment () ; 
outstrC"»»") ; 
nlO; 

dotakeof C) ; 

} 
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else if (amatch("var",3))dovar() ; 

else if (amatch( "struct" ,6))prstrct(dostruct()) ; 

else if (amatch(tfunc/*"func"*/,4))dofunc() ; 

else if (amatch("inethod",6))doinetliod() ; 

else 

{ 

error("wrong declaration- top level"); 
reset ; 

} 

blanks ; 

} 

} 

func f indtyp(snaiiie:*char) 
{ 

var int:res; 
var *char:p; 
res=l ; 

while (res<typptr) { 
p=typtab [res] .name; 

if (astreqCsname ,p,NAMEMAX) ) return res; 

res++; 

} 

return 0; 

} 

func dostructO 
{ 

var [NAMES I ZE] char : sname ; 

var [NAMESIZE] char : f name ; 

var int : t ; 

var int : sz ; 

/*var *int:top;*/ 

var int:ttop; 

var int:offs; 

var int: res; 

if (typptr>=numtyp) { 

/*fprintf (stderr , "reallocating types\n") ; */ 
numtyp=numtyp+NUMTYP ; 

chkmem(typtab=realloc (typtab , sizeof (styp) *numtyp) ) ; 
> 

res=typptr++; 

if (! symname (snEiine) ) error ("structure name exected"); 
if (findtyp (sname)) error ("multidef type") ; 
comment ; 

outstr ("naime of struct:"); 

outstr (sname) ; 

nlO; 

comment () ; 
outstr("ltypptr=") ; 
outdec(typptr) ; 
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nlO; 

strep (typtab [res] . name , sname) ; 
typtabCres] .sort=V_STR; 
needbrac(tlcomp/*"{"*/) ; 

ttop=0 ; /*top=&typtab [res] . type*// *typtype+res*/ ; 
/* *top=0;*/typtab[res] .type=0; 
offs=0; 
while(l){ 
blanks ; 
if (iseof )breal5;; 
/*if (cli()=='>')break;*/ 
if (streq(line+lptr ,trcomp) )break; 
if (amatch(tf unc/*f unc*/ , 4) ) 
{ 

if (cbtypeO ) 

t=gettypen() ; 
else t=T_lNT; 
t=getfnctype(t) ; 
if ( ! symname (f name) ) 

error ("method name expected"); 
nsO ; 
if (Ittop) 

{ 

commentO ;outstr("BEGlNNING\n") ; 
typtab [res] .type=af ield(t,fname,of f s) ; 
ttop=typtab [res] .type; 
} 

else 
{ 

commentO ;outstr("assigning") ; 

f ieldtab[ttop] .next=af ield(t,fname,offs) ; 

nlO; 

ttop=f ieldtab [ttop] .next; 
} 

/**top=af ield(t , f name , of f s) ;*/ 

/*top=&f ieldtab [*top] .next;*/ 

/*sz=gettsize(t) ; 

if (sz&3) sz=sz+4- (sz&3) ; 

of f s=of f s+sz; */ 

continue ; 

} 

var int:istyp; 
istyp=0; 
if (cbtypeO) 
{ 

t=gettypen() ; 

istyp=l ; 

if (matchC':")); 

} 
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var *ssyTiilist:lst,lsptr; 
var **ssymlist : Ipom; 
lst=lsptr=0 ; 
lpom=&lst ; 

while (symname (f name) ) 
{ 

chkmemC (*lpoin) =calloc (1 , sizeof (ssymlist) ) ) ; 

strcp((*lpom)->sym.nEmie,fnaine) ; 

lpom=&(*lpom)->iiext ; 

(*lpom)=0; 

blanks ; 

if (istyp) 

{if (streq(line+lptr, " ; "))break;} 
else 

{if (streq(line+lptr , " : ") )break; } 
if (endst ) break; 
if (ImatchC',")) 

{ 

error ( " ' , ' or expected" ) ; 

junkO ; 

break; 

} 

} 

if ( ! istyp) 
{ 

if (ImatchC':")) 

error("':' expected for Pascal-style declaration"); 
t=gettypen() ; 
istyp=l; 
} 

nsO ; 

/*if ( ! symname (f name) ) { 

error ("field name expected"); 

reset ; 

>*/ 

f or (lsptr=lst ; Isptr ;lsptr=lsptr->next) 
{ 

comment ; out str(" adding ") ; outstr (lsptr->S3rai.name) ; 
outstr(" : ") ;outdec(t) ;nl() ; 
if (Ittop) 
{ 

typtab [res] .type=af ield(t,lsptr->syTn.name,of f s) ; 
ttop=typtab [res] .type; 

} 

else 
{ 

var int : alpha ; 

commentO ;outstr("ttop=") ;outdec(ttop) ;nl() ; 
alpha=afield(t,lsptr->sym. name, off s) ; 
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f ieldtab[ttop] .next=gggg() ; 

commentO ;outstr("f ieldtab[ttop] .next=") ; 

outdec(f ieldtab [ttop] .next) ;nl() ; 

f ieldtab [ttop] .next=alpha; 

/ *f ieldtab [ttop] .iiext=af ield(t , lsptr->sym.name,of f s) ; */ 

commentO ;outstr("f ieldtab[ttop] .next=") ; 

outdec(f ieldtab [ttop] .next) ; 

ttop=f ieldtab [ttop] .next; 

} 

commentO ;outstr("ttop=") ;outdec(ttop) ;nlO ; 

prstrct (res) ; 

/**top=af ield(t , lsptr->syTn.name ,of f s) ; 

commentO ;outstr("*top=") ;outdec(*top) ;nlO ; 

top=&f ieldtab [*top] .next;*/ 

sz=gettsize(t) ; 

if (sz&3) sz=sz+4- (sz&3) ; 

of f s=of f s+sz; 

} 

delsymlist(lst) ; 
> 

commentO ; 
outstr("2typptr=") ; 
outdec(typptr) ; 
nlO; 

typtab[res] .size=offs; 
needbrac(trcomp/*">"*/) ; 
nsO ; 

commentO ; 
outstr ("typptr=") ; 
outdec(typptr) ; 
nlO; 

return res; 

} 

func freefieldsO 
{ 

if (f ieldtab) 
free (f ieldtab) ; 

} 

func initfieldsO 
{ 

nmstrele=NMSTRELE ; 

chkmem(f ieldtab=calloc(nmstrele,sizeof (sf ield))) ; 

} 

func freetypesO 
{ 

if (typtab) 
free(typtab) ; 

} 

func inittypesO 
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{ 

nuintyp=NUMTYP ; 

chkmem(typtab=calloc(nuintyp, sizeof (styp) ) ) ; 

strep (typtab[T_INT] . name , " int " ) ; 

typtab[T_INT] .sort=V_FND; 

typtab[T_INT] . size=WORDSIZE; 

strep (typtab[T_CHAR] .name , "char") ; 

typtab [T_CHAR] . sort=V_FND ; 

typtab[T_CHAR] . size=BYTESIZE; 

typtab [T_INTP] .naine[0]=0; 

typtab [T_INTP] .sort=V_PTR; 

typtab [T_INTP] .type=T_INT; 

typtab [T_INTP] . size=WORDSIZE; 

typtab [T_CHARP] . name [0] =0 ; 

typtab [T_CHARP] .sort=V_PTR; 

typtab [T_CHARP] .type=T_CHAR; 

typtab [T_CHARP] . size=WORDSIZE; 

} 

func initstO 

{ 

} 

func prstrct (s : int) 
{ 

var int : k ; 

comment () ; 

outstr ("structn "); 

outdec (s) ; 

outstr (" sz:"); 

outdec (typtab [s] . size) ; 

outstr (" neime ") ; 

outstr (typtab [s] .name) ; 

nlO; 

k=typtab[s] .type; 

while (k)-[ 

comment () ; 

outstr ("type ") ; 

outdec (fieldtab[k] .type) ; 

outstr (" "); 

outstr (fieldtab[k] .name) ; 
nlO; 

k=f ieldtab[k] .next; 
> 

} 

func f indf iel (nm: *char , s : int) 
{ 

var int : k ; 
comment () ; 
outstr ("typsortC") ; 
outdec (s) ; 
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outstr("]=") ; 
outdec(typtab[s] .sort) ; 
nlO; 

if (typtab[s] . sort ! =V_STR) { 

error ("cannot find a field in a non-struct") ; 

return 0; 

> 

k=typtab[s] .type; 
while (k){ 

if (strid(nin,fieldtab[k] .name) )return k; 

k=f ieldtab[k] .next; 

} 

return 0; 

} 

f unc af ield(t : int ,f nemie : *char , of f s : int) 
{ 

/*f printf (stderr , "strptr=7od\n" , strptr) ; */ 
commentO ; outstr ("strptr=") ;outdec (strptr) ;nl() ; 
if (strptr>=nmstrele) 
< 

/*f printf (stderr , "reallocating field table\n");*/ 
commentO ;outstr("reallocating field table") ;nl() ; 

nmstrele=nmstrele+NMSTRELE; 

commentO ; outstr ("nmstrele=") ; outdec (nmstrele) ;nlO ; 
chkmem(f ieldtab=realloc(f ieldtab,nmstrele*sizeof (sf ield) ) ) ; 

> 

strcp(fieldtab [strptr] .name.fname) ; 
fieldtab [strptr] .type=t; 
fieldtab [strptr] . of f set=of f s ; 
fieldtab [strptr] .next=0; 

commentO ; outstr ("++, strptr=") ; outdec (strptr) ;nl() ; 
return strptr++; 

} 

func ggggO {return 209;} 

func endstO 

{ 

blanks ; 

return ( (ch()==' ; ' ) I I (ch()==0) ) ; 

} 

func delsymlist(p:*ssymlist) 
{ 

if ( !p) return; 
delsymlist (p->next) ; 
free(p) ; 

} 

func dovarO 
{ 

var int:typ,istyp,wdfd; 
var *ssymlist:lst,lptr; 
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var **ssyTiilist : Ipom; 

var *ssym:idx; 

var [NAMES I ZE] char : sname ; 

istyp=0; 

lst=lptr=0; 

lpom=&lst ; 

wdfd=l; 

while (1) 

i 

i f ( amat ch ( " ext em " , 6 ) ) wdf d=0 ; 
else break; 

} 

if (cbtypeO) 
i 

istyp=l; 
typ=gettypen() ; 
while (1) 
{ 

if ( amat ch( "extern" , 6) ) wdf d=0 ; 
else break; 

} 

if (ImatchC":")) 
error("':' expected"); 
while (1) 
{ 

if (amat ch ( " extern" , 6) ) wdf d=0 ; 
else break; 

} 

} 

blanks ; 

if (!an(ch()) ) error ("expected name of variable"); 

while (symname (sname) ) 

i 

chkmein( (*lpoin)=calloc (1 , sizeof (ssymlist) ) ) ; 
strcp((*lpom)->sym. name, sname) ; 
lpoin=&(*lpoin)->next ; 
(*lpoin)=0; 

if (istyp) 

{if (match("; "))break;} 
else 

{if (matchC : "))break;} 
if (endst ()) break; 
if (!inatch(",")) 
{ 

error ("',' or ' : ' \ ' ; ' expected"); 
junkO ; 
break ; 

} 
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if ( ! istyp) 
i 

while (1) 
■C 

i f ( amat ch ( " ext ern " , 6 ) ) wdf d=0 ; 

else 

break ; 

> 

typ=gettypen() ; 

while (1) 

{ 

if (amatchC "extern" , 6) ) wdf d=0 ; 

else 

break ; 

} 

nsO ; 

} 

f or (lptr=lst ; Iptr ; lptr=lptr->next) 
i 

idx=f indglb(lptr->S3rai.name) ; 

if (idx) 

{ 

if (idx->sort ! =S_VARG) 
{ 

error ("multidef global var"); 
break; 

} 

else if(idx->dfd) 
{ 

error ("multidef global var, was defined"); 
break ; 

} 

else if (typ ! =idx->type) 
{ 

error ("conflicting types!"); 
break; 

} 

> 

addglb (lptr->sym . name , S_VARG , wdf d , , typ) ; 
if (wdf d) ++nvars ; 

} 

delsymlist (1st) ; 

} 

func addmacO 
{ 

comment ; 
ol(".mac") ; 

} 

func match(lit : *char) 



22 



{ 

var int:k; 
blanks ; 

if (k=streq(line+lptr , lit) ) { 

lptr=lptr+k; 

return 1; 

} 

return 0; 

} 

func streqCstrl :*char,str2:*char) 

{ 

var int : k ; 
k=0; 

while (str2 [k]){ 

if (strl[k] !=str2[k]) return 0; 

++k; 

> 

return k; 

} 

func stridCstrl :*char,str2:*char) 
{ 

var int : k ; 

k=0; 

while (str2 [k]){ 

if (strl[k] !=str2[k]) return 0; 

++k; 

> 

if (strl[k] ) return 0; 
return 1; 

} 

func ainatch(lit:*char,len:int) 
{ 

var int : k ; 
blanks () ; 

if (k=astreq(line+lptr,lit,len) ){ 

lptr=lptr+k; 

return 1; 

> 

return 0; 

} 

func blanks () 
{ 

while (1) 
i 

whiledchO) 
{ 

insline () ; 

preproce () ; 

if (iseof )break; 



} 

if(ch()==' ')gch(); 
else 

if (ch()==9)gch(); 
else 

return ; 

> 

} 

func cin(c:char) 
{ 

/♦return ((alpha(c)) I I (numeric (c) ) ) ;*/ 

return ((c>='a')&&(c<='zO) I I ((c>='A')&&(c<='Z')) I I 

((c>='0')&&(c<='9')) I I (€=='_'); 

} 

func numeric (c : char) 
{ 

return ((c>='0')&&(c<='9')) ; 

} 

func alpha ( c : char ) 
{ 

return (((c>='a')&&(c<='z')) I I ((c>='A')&&(c<='Z')) I I (c=='_')) ; 

} 

func gch() 
{ 

if (! ch() ) return 0; 
return line [lptr++] ; 

} 

func ch() 
{ 

return line [Iptr] ; 

} 

func inslineO 
{ 

var int : k ; 

if ( ! isinp) iseof =1 ; 

if (iseof) return ; 

lptr=0 ; 

line [0]=0; 

while ( (k=getchar ) >0) { 

if ((k==10) I I (lptr>=linemax))break; 

line[lptr++] =k; 

> 

line [Iptr] =0; 
if (k<0)isinp=0; 
if (Iptr) { 
comment ; 
outstr(line) ; 
nlO; 
lptr=0 ; 
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} 

cline++; 

} 

func preproceO 

{ 

} 

func astreq(strl : *char, str2: *char ,len: int) 
{ 

var int : k ; 
k=0; 

while (k<len){ 

if ((strlCk]) !=(str2[k])) break; 

if (Istrl [k]) break; 

if (!str2 [k]) break; 

++k; 

> 

if (an (strl [k] )) return 0; 
if (an (str2[k] )) return 0; 
return k; 

} 

func domethodO 
{ 

meth.odcls=l ; 

var [NAMESIZE] char : tname .mneime ; 
if ( ! symname (tname) ) 

{error ("symbol name expected") ;methodcls=0;return;}- 
if (! (match(" . ") | |match(" ::"))) 

{error ("'.' or '::' expected") ;methodcls=0; return;} 

if ( ! symnaime (mnaime) ) 

{error ("method name expected") ;methodcls=0;return;}- 
var int : stridx ; 
stridx=findtyp (tname) ; 
if (! stridx) 

{error("no such type") ;methodcls=0; return;} 
if (typtab [stridx] . sort ! =V_STR) 

{error("must be a structure to have a method") ;methodcls=0;return;} 
var int : k ; 

if ( ! (k=f indf iel (mname , stridx) ) ) 

{error("no such method") ;methodcls=0; return;} 

if (typtab [fieldtab[k] .type] . sort ! =V_FMC) 

{error ("method must be a function") ;methodcls=0;return;} 

methodcls=stridx;/*the type in which the method is*/ 

methodidx=k; /*the index of the method in fieldtab*/ 

dof unc ; 

methodcls=0 ; 

methodidx=0 ; 

} 

func dofuncO 
{ 
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var [NAMES I ZE] char :n; 

var [NAMES I ZE] char: argn; 

Vcir int : argtype ; 

var *ssym:gp; 

var int:k; 

comment ; 

olC'.fnc") ; 

if (methodcls&femethodidx) 
i 

strep (n,typtab[methodcls] .name) ; 
strcatCn, ".");/* DANGEROUS !! */ 

strcat(n,fieldtab[methodidx] .name) ;/* DANGEROUS- FixMe */ 

} 

else if ( ! symname (n) ) 
{ 

errorC'wrong function declaration"); 

reset () ; 
return ; 

} 

comment () ; 
outstr("» "); 
outstr(n) ; 
nlO; 

gp=f indglb(n) ; 
/♦comment ; 
outstrC'gp: ") ; 
outdec(gp) ; 
nlO;*/ 
if (gp){ 

if (gp->sort ! =S_FUNC) error ( "mult idef " ) ; 
} 

else 
{ 

gp=addglb (n , S_FUNC , , , T_INT) ; 

> 

if ( ! mat ch (tlarg/* "("*/)) error ( "missing '('"); 
argstk=0 ; 
Zsp=0 ; 

/*locptr=STARTLOC ; */ 
ssymtabfreeC&locsymtab) ; 
if (methodcls&ftmethodidx) 
{ 

addloc ( " thi s " , S_VARL , 1 , argstk+8 , getptrty (methodcls ) ) ; 
argstk=argstk+sizeof (*int) ; 

} 

while ( ! match (trarg/* " )"*/)) 
{ 

if (cbtypeO ) 
{ 
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argtype=gettypen() ; 
if (matchC':")); 
if ( ! sjminame (argn) ) 
{ 

error ("parameter name expected"); 
junkO ; 

} 

/*if (endst )break; */ 

} 

else 
{ 

if ( ! symneime (argn) ) 
{ 

error ("parameter name expected"); 
junkO ; 

} 

if (endst ) break; 

if (! match (" : "))error(" ' : ' expected") ; 
argtype=gettypen() ; 

> 

k=gettsize(argtype) ; 
if (k&3)k=k+4-(k&3); 

addloc (argn , S_VARL , 1 , argstk+8, argtype) ; 

argstk=argstk+k ; 

if (!match(","))if (ch() !=')') 

{ 

error ("comma or ')' expected"); 
break ; 

} 

if (endst ) break; 

> 

if (match(" ; ") )return ; 
nfunc++; 

var *snamelist : savenmlst ; 
savenmlst=cnmlst ; 
cnmlst=gp->nmlst ; 
var *scodegen: savecg; 

/*f printf (stderr , "dof unc : ccg=°/od\n" , ccg) ; */ 
savecg=ccg; 

/*f printf (stderr , "dof iinc : savecg=7.d\n" , savecg) ; */ 
var scodegen: codeg; 
cg_init (&codeg) ; 
ccg=&codeg; 

if (gp->dfd) error ("this function was already defined"); 

gp->dfd=l; 

ol(" .text") ; 

ol(" .align 16") ; 

outasm(" .globl ") ; 

outname (n) ; 
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nlO; 

otC'.type"); 

tabO ; 

outname (n) ; 

outasmC .Ofunction") ; 

nlO; 

outname (n) ; 

colO ; 
nlO; 

/*ol("pushl '/,ebp") ; 
olC'movl %esp, 7,ebp");*/ 
zenterO ; 
statemenO ; 

/*ol("movl y.ebp, 7,esp"); 
olC'popl y.ebp");*/ 
zleaveO ; 

zret ; 

cg_priiit (fecodeg) ; 
cg_done(&codeg) ; 

/*f printf (stderr , "dof iinc : savecg=7.d\n" , savecg) ; */ 

ccg=savecg; 

cninlst=saveninlst ; 

/*f printf (stderr , "dof iinc : ccg=%d\n" , ccg) ; */ 

} 

func _zret() 
{ 

olC'ret") ; 

} 

func StatemenO 
{ 

/*f printf (stderr , "statemenO : ccg=7.d\n" , ccg) ;*/ 

blanks ; 

if ((!chO)&&iseof)return 0; 
else 

if (ELmatch("var" ,3) )dolocvar () ; 
else if (match(tlcomp/*"{"*/))compoundO ; 
else if (amatch("if",2)) 
{ 

doif O; 
lastst=stif ; 

} 

else if (amatch("while",5)) 
{ 

dowhile ; 
lastst=stwhile ; 
} 

else if (amatch("for" ,3)) 
{ 

dof or() ; 
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lastst=stf or ; 
} 

else if (amatchC'do" ,2)) 
{ 

dodoO ; 

lastst=stdo; 

} 

else if (amatchC'return" ,6) ) 
{ 

doreturnO ; 

ns() ; 

lastst=streturn; 
} 

else if (ainatch("break",5)) 
{ 

dobreakO ; 

nsO; 

lastst=stbreak; 
} 

else if (amatchC continue", 8)) 
{ 

docontO ; 

nsO; 

lastst=stcont ; 
} 

else if (matchC';")) ; 
else 
{ 

expressiO ; 
nsO ; 

lastst=stexp; 
> 

return lastst; 

} 

func doreturnO 
{ 

if (lendstO ) expressiO ; 

zleave ; 

/*ol("movl y.ebp, "/.esp"); 
olC'popl y.ebp");*/ 
zretO ; 

} 

func compound O 

{ 

++ncmp ; 

whileC !match(trcomp/*">"*/)) 
i 

statemenO ; 

if (iseof )break; 



} 

— ncmp ; 

} 

func modstk(newsp: int) 
{ 

var int : k ; 

k=newsp-Zsp ; 

if ( !k) return newsp; 

cmodstk(k) ; 

return newsp; 

if (k>0){ 

otC'addl $"); 

outdec(k) ; 

out asm (" , Zesp") ; 

nlO; 

return newsp; 

> 

else 
i 

otC'subl $") ; 
outdec(-k) ; 
outasmC, %esp"); 
nlO; 

return newsp; 

> 

> 

func dolocvarO 
{ 

var [NAMESIZE] char : sname ; 

var int: pi; 

var int:typ,istyp; 

var *ssyin:idx; 

var int : k ; 

var *ss3milist:lst,lptr; 

var **ssymlist : Ipom; 

lst=lptr=0; 

lpom=&lst ; 

istyp=0; 

if (cbtype ) 

i 

/ *f printf (stderr , "line=7os\n" , line) ; 
f printf (stderr , "can be type\n");*/ 
istyp=l; 
typ=gettypen() ; 

if (ImatchC : "))error(" ' : ' expected") ; 
k=gettsize(typ) ; 
comment ; 
outstr("size: ") ; 
outdec(k) ; 



30 



nlO; 

if (k&3)k=k+4-(k&3); 
comment ; 
outdec(k) ; 
nlO; 

> 

blanks () ; 

if (! anCchO )) error ("expected name of variable"); 

/*pl=locptr;*/ 

while (symname (sname) ) 

< 

chkmemC (*lpom)=calloc (1 , sizeof (ssymlist) ) ) ; 
strcpC (*lpom)->sym. name, sname) ; 
lpom=&(*lpom)->next ; 
(*lpom)=0; 
if (istyp) 

{if (match(";"))break;} 
else 

{if (match(":"))break;} 

if (endst () )break; 
if dmatchC',")) 
{ 

error ("',' or expected"); 
junkO ; 
break ; 

} 

> 

if ( ! istyp) 
{ 

typ=gettypen() ; 
nsO ; 

k=gettsize(typ) ; 
comment ; 
outstr("size: ") ; 
outdec(k) ; 
nlO; 

if (k&3)k=k+4-(k&3); 

comment () ; 
outdec(k) ; 
nlO; 

} 

f or (lptr=lst ; Iptr ; lptr=lptr->next) 
{ 

idx=f indloc (lptr->sym.name) ; 

/*f printf (stderr , "adding °/os\n" ,lptr->sym.name) 

if (idx) 

{ 

error("local multidef"); 

} 
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addloc (lptr->syin . name , S_VARL , 1 , Zsp-k , typ) ; 
Zsp=inodstk(Zsp-k) ; 

} 

/* while (symiicimeCsnaine)) 
i 

idx=f indloc(snaine) ; 
if (idx){ 

errorC'local multidef"); 
} 

addloc (sname , S_VARL , 1 , Zsp-k, typ) ; 

Zsp=modstk (Zsp-k) ; 

if (matchC; "))break; 

if (endst ) break; 

if (ImatchC',")) 

{ 

error ("',' or ' ; ' expected"); 

j unk ( ) ; 
break; 

} 

}*/ 

delsymlist (1st) ; 

} 

func doifO 
{ 

/*var int:flev;*/ 
var **ssymlist :f lev; 
var int : f sp ; 
var int:flabl; 
var int:flab2; 
f lev=locsymtab . front ; 
/*f lev=locptr ; */ 
f sp=Zsp; 

flabl=getlabel() ; 

test(flabl) ; 

statemenO ; 

Zsp=modstk(f sp) ; 

/*locptr=f lev;*/ 

ssymtabcut (felocsymtab.f lev) ; 

if ( ! amat ch ( " else " , 4) ) { 

/*printlab(flabl) ; 

colO ; 

nlO;*/ 

clab(flabl) ; 

return ; 

} 

juinp(flab2=getlabel()) ; 
/*printlab(flabl) ; 
coK); 
nlO;*/ 
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clab(flabl) ; 

statemenO ; 

Zsp=modstk(f sp) ; 

/*locptr=f lev; */ 

ssymtabcut (&locsymtab,f lev) ; 

/*printlab(flab2) ; 

coK); 

nlO; 

*/ 

clab(flab2) ; 

} 

func test (label : int) 
{ 

needbracCtlarg/*" ("*/) ; 
express! ; 

needbracCtrarg/*") "*/) ; 
testjump(label) ; 

} 

func dobreakO 

{ 

var iiit:ptr; 
if ( Iwqptr) return ; 
ptr=readwliil ; 
modstk(wqsp [ptr] ) ; 
jumpCwqlab [ptr] ) ; 

> 

func docontO 
{ 

var int : ptr ; 
if ( Iwqptr) return ; 
ptr=readwhil() ; 
modstk (wqsp [ptr] ) ; 
jumpCwqloop [ptr] ) ; 

} 

func doforO 
{ 

var **ssyTnlist :thes5nn; 

var intrthesp; 

var int:theloop,thecont; 

var int : thelab ; 

var int : tl ; 

/ *thesym=locptr ; */ 

thesyin=locsyintab .front ; 

th.esp=Zsp; 

theloop=getlabel() ; 

thelab=getlabel() ; 

tiiecont=getlabel ; 

addwhile (thesym , thesp , thecont , thelab) ; 
needbracCtlarg/*" ("*/) ; 
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expressiO;/* i=0 */ 
nsO ; 

/*printlab(theloop) ; 
colO; 
nlO ;*/ 
clab(theloop) ; 
expressiO;/* i<N */ 
test jump(thelab) ; 
ns() ; 

/*f printf (stderr , "dof or : ccg=7.d\n" , ccg) ; */ 

var *scodegen: savecg; 

savecg=ccg; 

/*f printf (stderr , "dof or : savecg=%d\n" , savecg) 

var scodegenrcgl; 
cg_init(&cgl) ; 
ccg=&cgl; 

tl=getlitst() ; 

/*printlab(thecoiit) ;col() ;iil() ;*/ 
clab(thecont) ; 

blanks () ; 

if (!streq(line+lptr,trarg)/*ch() !=') '*/) 

expressiO;/* i++ */ 

var scodegen: cg2; 

cg_init(&cg2) ; 

ccg=&cg2 ; 

getlitst ; 

needbracCtrarg/*") "*/) ; 

statemenO ; 

Zsp=modstk(thesp) ; 

/*cg_print(&cg2) ;*/ 

cg_transfer(&cg2, savecg) ; 

cg_done (&cg2) ; 

/*cg_print (&cgl) ; */ 

cg_transfer(&cgl .savecg) ; 

cg_done (fecgl) ; 

ccg=savecg; 

dumpltst(tl) ; 

jnmp(theloop) ; 

/*printlab(thelab) ; 

colO; 

nlO ;*/ 

clab(thelab) ; 

/*locptr=thesyin ; */ 

ssymtabcut (&locsymtab,thesym) ; 

delwhile ; 

} 

func dodoO 
{ 

var *ss3railist ithesjm; 
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var int:thesp; 
Vcir int : theloop ; 
Vcir int:thelab; 
/*thesym=locptr ; */ 
thesym=locsymtab . front ; 
thesp=Zsp; 
theloop=getlabel() ; 
thelab=getlabel ; 

addwhile (thesym , thesp , theloop , thelab) ; 

/*printlab (theloop) ; 

colO ; 

nlO;*/ 

clab (theloop) ; 

statemenO ; 

Zsp=modstk (thesp) ; 

if ( ! amatchC'while" , 5) ) { 

error ( " ' while ' expected" ) ; 

> 

needbrac(tlarg/*" ("*/) ; 

expressi () ; 

/*ol("testl 7.eax, "/.eax"); 
otC'jne") ; 
tabO ; 

printlab (theloop) ; 
nlO;*/ 

testnejump (theloop) ; 

/*printlab (thelab) ; 

coK); 

nlO ;*/ 

clab (thelab) ; 

needbrac(trarg/*") "*/) ; 

ns() ; 

/ *locptr=thesym ; */ 
ssyintabcut(&locsymtab, thesym) ; 
delwhileO ; 

} 

func dowhileO 
{ 

var **ssymlist : thesym; 
var int: thesp; 
var int: theloop; 
var int: thelab; 
/*thesym=locptr ; */ 
thesym=locsymtab . front ; 
thesp=Zsp; 
theloop=getlabel() ; 
thelab=getlabel ; 

addwhile (thesym , thesp , theloop , thelab) ; 
/*printlab (theloop) ; 
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colO; 

nlO ;*/ 

clab(theloop) ; 

test(thelab) ; 

statemenO ; 

Zsp=modstk(thesp) ; 

jump(theloop) ; 

/*priiitlab(thelab) ; 

coK); 

nlO;*/ 

clab(tlielab) ; 

/*locptr=thesym; */ 

ssymtabcut (&locsyintab,thesym) ; 

delwhileO ; 

} 

f unc addwhile (sym : int , sp : int , loop : int , lab : int) 
{ 

if (wqptr>=WQMAX) { 

errorC'too many nested loops"); 

return ; 

} 

wqsym [wqptr] =sym ; 
wqsp [wqptr] =sp ; 
wqloop [wqptr] =loop ; 
wqlab [wqptr] =lab ; 
wqptr++ ; 

} 

func readwhilO 
{ 

if ( ! wqptr) { 

errorC'no active loops"); 

return 0; 

} 

return wqptr- 1; 

> 

func delwhileO 
{ 

if (wqptr>0) wqptr — ; 

} 

func _zpush() 
{ 

olC'pushl y.eax") ; 
Zsp=Zsp-4; 

> 

func _mult() 
{ 

ol("imull '/,edx") ; 

} 

func _zpop() 
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{ 

olC'popl %edx"); 
Zsp=Zsp+4; 

} 

func _zmod() 
{ 

divO ; 

olC'movl y.edx, '/,eax") ; 

} 

func _div() 
{ 

olC'xchgl y.eax, %edx"); 
OlC'movl 7.edx, 7,ecx"); 
olC'cltd") ; 
olC'idivl %ecx"); 

} 

func _increg(k: int) 
{ 

if (!k) return ; 

if (k<3) while (k~) ol ( " incl %eax 

else 

i 

otC'addl $"); 
outdec(k) ; 
outstrC, %eax"); 
nlO; 

> 

} 

func _decreg(k: int) 
{ 

if (!k) return ; 

if (k<3) while (k~) ol ( "decl %eax 

else 

i 

otC'subl $"); 
outdec(k) ; 
outstrC, %eax"); 
nlO; 

> 

} 

func _mulreg(k:int,s:*char) 
{ 

var int : 1 ; 

if (k==l)return ; 

else 

if (k==0)-[ 

otC'xorl "); 
outstr(s) ; 
outstrC, "); 



outstr(s) ; 
nlO; 

} 

else 
{ 

1=1; 

while (K15) if (k==(l«l)){ 
otC'sall $"); 
outdec(l) ; 
outstrC, "); 
outstr (s) ; 
nlO; 
return ; 

> 

else 
1++; 

} 

otC'imull $"); 
outdec(k) ; 
outstr (", "); 
outstr(s) ; 
nlO; 

} 

func _divconst(k:int) 
{ 

var int : 1 ; 

if (k==l) return ; 

if(!k){ 

error ("division by zero"); 

return ; 

> 

1=1; 

while (K15) if (k==(l«l)){ 

ot("sarl $"); 

outdec (1) ; 

outstr (", y.eax"); 

nlO; 

return ; 

> 

else 
1++; 

ol("cltd") ; 
ot("divl $"); 
outdec (k) ; 
nlO; 

} 

func _zadd() 
{ 

ol("addl %edx, '/.eax") ; 



func _zsub() 
{ 

olC'subl 7.eax, 7,edx"); 
olC'movl 7.edx, %eax") ; 

} 

func _neg() 
{ 

olC'negl %eax"); 

} 

func _zeq() 
{ 

otC'cmpl") ; 
otCy.eax, %edx"); 
nlO; 

otC'sete") ; 
otCy.al") ; 
nlO; 

otC'movzbl") ; 
otCy.al, y.eax"); 
nlO; 

} 

func _zne() 
{ 

OtC'cmpl") ; 

ot(" y.eax, y.edx"); 

nlO; 

otC'setne") ; 

otCy.al"); 

nlO; 

OtC'movzbl") ; 
ot("yal, y.eax"); 
nlO; 

} 

func _zge() 
{ 

ot("cmpl") ; 

ot(" y.eax, y.edx"); 

nlO; 

ot("setge") ; 
ot("y.al") ; 
nlO; 

ot("movzbl") ; 
ot("y.al, y.eax"); 
nlO; 

} 

func _uge() 
{ 

ot("cmpl") ; 



ot("7,eax, 7,edx"); 
nlO; 

ot(" setae") ; 

ot("7.al"); 

nlO; 

otC'movzbl") ; 
ot("7,al, 7.eax"); 
nlO; 

} 

func _ule() 
{ 

otC'cmpl") ; 
ot("7.eax, 7.edx"); 
nlO; 

otC'setbe") ; 

ot("7.al"); 

nlO; 

OtC'movzbl") ; 
ot("7.al, 7.eax"); 
nlO; 

} 

func _zle() 
{ 

ot("cmpl") ; 
ot("7.eax, 7.edx"); 
nlO; 

ot("setle") ; 

ot("7.al"); 

nlO; 

ot("movzbl") ; 
ot("7.al, 7.eax"); 
nlO; 

} 

func _ult() 
{ 

ot("cmpl") ; 
ot("7.eax, 7.edx"); 
nlO; 

ot("setb") ; 

ot("7.al"); 

nlO; 

ot("movzbl") ; 
ot("7.al, 7.eax"); 
nlO; 

} 

func _zlt() 
{ 

ot("cmpl") ; 
ot("7.eax, 7.edx"); 



nlO; 

otC'setl") ; 

otC'/.al"); 

nlO; 

otC'movzbl") ; 
otCy.al, %eax"); 
nlO; 

} 

func _ugt() 
{ 

otC'cmpl") ; 
ot("7.eax, y.edx"); 
nlO; 

otC'seta") ; 

ot("7.al"); 

nlO; 

OtC'movzbl") ; 
otCy.al, y.eax"); 
nlO; 

> 

func _zgt() 
{ 

OtC'cmpl") ; 

ot(" y.eax, y.edx") ; 

nlO; 

ot("setg") ; 

ot("y.al"); 

nlO; 

ot("movzbl") ; 
ot("y.al, y.eax"); 
nlO; 

} 

func _zor() 
{ 

olC'orl y.edx, y.eax" 

} 

func _zxor() 
{ 

olC'xorl y.edx, y.eax 

} 

func _zaiid() 
{ 

olC'andl y.edx, y.eax 

} 

func _asr() 
{ 

olC'movl yeax, yecx 
olC'movl y.edx, y.eax 
ol("sarl y.cl, y.eax" 



func _asl() 
{ 

olC'movl 7.eax, Zecx"); 
olC'movl y.edx, °/.eax"); 
olC'sall %cl, %eax"); 

} 

func _lnot() 
{ 

olC'testl %eax,%eax"); 
olC'sete y.al") ; 
olC'movzbl y.al, y.eax"); 

} 

func _bnot() 
{ 

olC'notl y.eax"); 

} 

func _testjump (label : int) 
{ 

OlC'testl y.eax, y.eax") ; 

ot("je"); 

tabO ; 

printlab (label) ; 
nlO; 

} 

func _testnejump (label: int) 
{ 

ol("testl y.eax, y.eax"); 

ot("jne") ; 
tabO ; 

printlab (label) ; 
nlO; 

} 

func _juinp (label: int) 
{ 

ot("jmp ") ; 
printlab (label) ; 
nlO; 

} 

func _zcall (sname : *char) 
{ 

ot("call "); 
outname (sname) ; 
nlO; 

} 

func printlab (label : int) 

{ 

outasm(" .L") ; 
outdec (label) ; 



} 

func indirect (Ival : *int) 

{ 

} 

func pretree (node : *enode , of il : *int) 
{ 

if ( !node) 
return; 

fprintf (ofil,"(") ; 

pretree (iiode->l , of il) ; 
if (node->op==OP_LEAF) 
i 

if (node->leaf . vid==L_NUM) 

fprintf (of il, ""/.d" ,node->leaf . val) ; 

else if (node->leaf .vid==L_STR) 

fprintf (of il, "\"\" " ,litq+node->leaf .val) ; 

else if (node->leaf . vid==L_ID) 

fprintf (of il , "°/„s" ,node->name) ; 

else 

error ("unknown leaf"); 

} 

else if (node->op==OP_LIST) 
i 

fprintf (of il," [] ") ; 

} 

else if (node->op==OP_FUNC) 
i 

fprintf (of il,"$") ; 

> 

else if (node->op==OP_COMMA) 
i 

fprintf (of il,",") ; 

} 

else if (node->op==OP_COND) 
i 

fprintf (of il,"?") ; 

} 

else if (node->op==OP_ASSIGN) 
i 

fprintf (of il,"=") ; 

} 

else if (node->op==OP_EQ) 
i 

fprintf (of il, "=="); 

} 

else if (node->op==OP_NECl) 
i 

fprintf (of il, "!="); 
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} 

else if (node->op==OP_GT) 
i 

fprintf (ofil,">") ; 

} 

else if (node->op==OP_LT) 
i 

fprintf (of il,"<") ; 

> 

else if (node->op==OP_GE) 
i 

fprintf (of il, ">="); 

} 

else if (node->op==OP_LE) 
i 

fprintf (of il,"<=") ; 

> 

else if (node->op==OP_SHL) 
i 

fprintf (of il,"«"); 

} 

else if (node->op==OP_SHR) 
i 

fprintf (of il,"»"); 

} 

else if (node->op==OP_BAND) 
i 

fprintf (of il,"&") ; 

} 

else if (node->op==OP_BOR) 
i 

fprintf (of il," 1") ; 

} 

else if (node->op==OP_BXOR) 
i 

fprintf (of il,"~") ; 

> 

else if (node->op==OP_LAND) 
{ 

fprintf (of il,"&&") ; 

} 

else if (node->op==OP_LOR) 
i 

fprintf (of il," I 1"); 

} 

else if (node->op==OP_PLUS) 
i 

fprintf (of il,"+") ; 

> 



else if (node->op==OP_MINUS) 
fprintf (ofil,"-") ; 

} 

else if (node->op==OP_MUL) 
i 

fprintf (ofil,"*") ; 

} 

else if (node->op==OP_DIV) 
i 

fprintf (ofil,"/") ; 

} 

else if (node->op==OP_REM) 
< 

fprintf (ofil, "%") ; 

} 

else if (node->op==OP_lPP) 
i 

fprintf (of 11,"++®") ; 

} 

else if (node->op==OP_lMM) 
i 

fprintf (ofil,"— @") ; 

} 

else if (node->op==OP_UMINUS) 
i 

fprintf (ofil, "u-"); 

> 

else if (node->op==0P_2PP) 
i 

fprintf (ofil, "@++") ; 

} 

else if (node->op==0P_2MM) 
i 

fprintf (ofil,"®--") ; 

} 

else if (node->op==OP_STAR) 
i 

fprintf (ofil,"*®"); 

} 

else if (node->op==OP_ADDR) 
i 

fprintf (ofil, "&®") ; 

} 

else if (node->op==OP_BNOT) 
i 

fprintf (ofil, "~") ; 

> 

else if (node->op==OP_LNOT) 



i 

fprintf (ofil,"!"); 

} 

else if (node->op==OP_DOT) 
i 

fprintf (ofil, " .%s" ,node->name) ; 

> 

else error ("unknown op"); 
pretree(node->r,of il) ; 
if (node->op==OP_COMD) 
< 

fprintf (ofil,":"); 
pretree(node->third,of il) ; 

} 

fprintf (ofil,")"); 



func cttype(node:*enode) 
{ 

if (! node) return T_INT; 
if (node->op==OP_LEAF) 
i 

if (node->leaf . vid==L_MUM) 
return T_INT; 

else if (node->leaf . vid==L_ID) 
return node->leaf . idx->type ; 
else if (node->leaf . vid==L_STR) 
return T_CHARP; 

} 

else if (node->op==OP_STAR) 
i 

var int : t ; 
t=cttype(node->r) ; 

if (typtab [t] . sort ! =V_PTR&&typtab [t] . sort ! =V_PTR) 
{error("star of non-ptr") ;return T_INT;}- 
return (typtab [t] .type) ; 

> 

else if (node->op==OP_ADDR) 
i 

var int:t; 

t=cttype (node->r) ; 

if (typtab [t] . sort==V_ARR) 

{error ("extre for array") ; return t ; J 

return getptrty(t); 

} 

else if (node->op==OP_PLUS) 
i 

var int:tl,t2; 

> 
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else if (node->op==OP_MINUS) 

i 

} 

else errorC'don't know the type"); 

} 

f unc treetocode (node : *enode , Ival : *elval) 
{ 

if ( !node) 
return 0; 

if (node->op==OP_LEAF) 
< 

if (node->leaf . vid==L_NUM) 
{ 

lval->sort=L_NUM; 
lval->idx=0; 
lval->off set=0; 
lval->typ=T_INT; 
lval->val=node->leaf . val ; 
return 1 ; 

> 

else if (node->leaf . vid==L_ID) 
{ 

lval->sort=L_ID ; 
lval->idx=node->leaf . idx ; 
lval->off set=0; 

lval->typ=node->leaf . idx->type ; 
strep (lval->neime,node->name) ; 
return 1 ; 

> 

else if (node->leaf . vid==L_STR) 
{ 

lval->sort=L_STR; 
lval->idx=0; 

lval->of f set=node->leaf .val; 
lval->typ=T_CHARP ; 
return 1 ; 

} 

else 

errorC'how to code a leaf?"); 

> 

else if (node->op==OP_COMMA) 
return ct_COMMA (node, Ival) ; 
else if (node->op==OP_LOR) 
return ct_LOR(node , Ival) ; 
else if (node->op==OP_LAND) 
return ct_LAND (node , Ival) ; 
else if (node->op==OP_BOR) 
return ct_BOR (node , Ival) ; 
else if (node->op==OP_BXOR) 
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return ct_BXOR(node , Ival) ; 
else if (node->op==OP_BAND) 
return ct_BAND (node , Ival) ; 
else if (node->op==OP_EC!) 
return ct_EQ (node , Ival) ; 
else if (node->op==OP_NEC!) 
return ct_NEQ (node, Ival) ; 
else if (node->op==OP_GT) 
return ct_GT (node , Ival) ; 
else if (node->op==OP_LT) 
return ct_LT (node, Ival) ; 
else if (node->op==OP_GE) 
return ct_GE(node , Ival) ; 
else if (node->op==OP_LE) 
return ct_LE(node , Ival) ; 
else if (node->op==OP_SHL) 
return ct_SHL (node, Ival) ; 
else if (node->op==OP_SHR) 
return ct_SHR(node , Ival) ; 
else if (node->op==DP_PLUS) 
return ct _PLUS (node, Ival) ; 
else if (node->op==OP_MINUS) 
return ct_MINUS (node , Ival) ; 
else if (node->op==OP_ASSIGN) 
return ct _ASSIGN (node, Ival) ; 
else if (node->op==OP_MUL) 
return ct _MUL (node, Ival) ; 
else if (node->op==OP_DIV) 
return ct_DIV (node, Ival) ; 
else if (node->op==OP_REM) 
return ct_REM(node , Ival) ; 
else if (node->op==OP_lPP) 
return ct_lPP (node, Ival) ; 
else if (node->op==OP_lMM) 
return ct_lMM (node , Ival) ; 
else if (node->op==0P_2PP) 
return ct_2PP (node , Ival) ; 
else if (node->op==DP_2MM) 
return ct_2MM (node , Ival) ; 
else if (node->op==OP_UMINUS) 
return ct_UMINUS (node, Ival) ; 
else if (node->op==OP_STAR) 
return ct_STAR(node , Ival) ; 
else if (node->op==DP_ADDR) 
return ct_ADDR (node , Ival) ; 
else if (node->op==OP_LNOT) 
return ct_LNDT (node, Ival) ; 
else if (node->op==OP_BNOT) 
return ct_BNOT (node , Ival) ; 



else if (node->op==OP_FUNC) 
return ct _FUNC (node , 1 val ) ; 
else if (node->op==OP_DOT) 
return ct_DOT(node , Ival) ; 
else errorC'to be implemented"); 

} 

f unc ct_COMMA(node : *enode , Ival : *elval) 

{ 

var *enode:cnode; 
var int : k ; 

var elval:lvall; 

f or (cnode=node ; cnode ; cnode=cnode->r) 
i 

k=treetocode(cnode->l,&lvall) ; 
if (k) rvalue (felvall) ; 
if (cnode->r&&cnode->r->op ! =OP_COMMA) 
return treetocode(cnode->r,lval) ; 

> 

} 

f unc ct_ASSIGN (node : *enode , Ival : *elval) 
{ 

Vcir int : k ; 

Vcir elval : Ivall , lval2 ; 
k=treetocode(node->l, felvall) ; 
if ( !k)-[needlval() ; return 0;} 
if (Ivall . sort==L_POI) 
i 

zpushO ; 

Ivall. sort =L_SP; 

> 

if (treet ocode (node->r , &lval2) ) rvalue (&lval2) ; 

lval->sort=L_ONREG ; 

lval->idx=0 ; 

lval->of f set=0; 

lval->typ=lval2 . typ ; 

store (felvall) ; 

return 0; 

} 

f unc ct_LOR(node : *enode , Ival : *elval) 
{ 

var elval: Ivall, lval2; 

var *enode : cnode ; 

var int:onelab,exitlab; 

if (treetocode(node->l,&lvall))rvalue(&lvall) ; 

onelab=getlabel ; 

exitlab=getlabel() ; 

testnejump(onelab) ; 

cnode=node->r ; 

while (cnode->op==OP_LOR) 
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i 

if (treetocode(cnode->l ,&lvall) ) rvalue (ftlvall) ; 
testnejump(onelab) ; 
cnode=cnode->r ; 

> 

if (treetocode(cnode ,&lval2) ) rvalue (&lval2) ; 

testnejump(onelab) ; 

/*ol("xorl '/,eax, '/.eax");*/ 

zldii(O) ; 

jump (ex it lab) ; 

/*priiitlab(onelab) ;col() ;nl() ;*/ 
clab(onelab) ; 
/*ol("niovl $1, 7,eax");*/ 

zldn(l) ; 

/*printlab(exitlab) ;col() ;nl() ;*/ 
clab(exitlab) ; 
lval->sort=L_ONREG ; 
lval->idx=0 ; 
lval->of f set=0; 
lval->typ=T_INT; 
return 0; 

} 

f unc ct_LAND (node : *enode , Ival : *elval) 
{ 

var elval : Ivall , lval2 ; 

var *enode : cnode ; 

var int :zerolab,exitlab; 

if (treetocode (node->l , fclvall) ) rvalue (fclvall) ; 

zerolab=getlabel ; 

exitlab=getlabel () ; 

testjump(zerolab) ; 

cnode=node->r ; 

while (cnode->op==OP_LAND) 

i 

if (treetocode(cnode->l ,&lvall) ) rvalue (ftlvall) ; 
test jump (zerolab) ; 
cnode=cnode->r ; 

> 

if (treetocode (cnode , &lval2) ) rvalue (&lval2) ; 
testjump (zerolab) ; 
/*ol("movl $1, Xeax");*/ 
zldn(l) ; 
jump(exitlab) ; 

/*printlab (zerolab) ;col() ;nl() ;*/ 

clab (zerolab) ; 

/*ol("xorl 7,eax, 7.eax");*/ 

zldn(O) ; 

/*printlab(exitlab) ;col() ;nl() ;*/ 
clab(exitlab) ; 
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lval->sort=L_ONREG ; 
lval->idx=0 ; 
lval->of f set=0 ; 
lval->typ=T_INT; 
return 0; 

} 

f unc ct_BOR(node : *enode , Ival : *elval) 
{ 

var elval:lvall,lval2; 

if (treetocode(node->l ,&lvall) ) rvalue (ftlvall) ; 

zpusliO ; 

if (treetocode(node->r,&lval2)) rvalue (&lval2) ; 
zpopO ; 
zor ; 

lval->sort=L_ONREG ; 
lval->idx=0; 
lval->of f set=0 ; 
lval->typ=T_INT; 
return 0; 

} 

f unc ct_BXOR(node : *enode , Ival : *elval) 
{ 

var elval : Ivall , lval2 ; 

if (treetocode(node->l,&lvall))rvalue(&lvall) ; 
zpushO ; 

if (treetocode(node->r,&lval2)) rvalue (&lval2) ; 
zpopO ; 
zxorO ; 

lval->sort=L_ONREG ; 
lval->idx=0 ; 
lval->of f set=0; 
lval->typ=T_INT; 
return ; 

} 

f unc ct_BAND (node : *enode , Ival : *elval) 
{ 

var elval : Ivall , lval2 ; 

if (treetocode(node->l,&lvall))rvalue(&lvall) ; 
zpushO ; 

if (treetocode (node->r , &lval2) ) rvalue (&lval2) ; 

zpopO ; 
zandO ; 

lval->sort=L_ONREG ; 
lval->idx=0 ; 
lval->of f set=0 ; 
lval->typ=T_INT; 
return 0; 

} 

f unc ct_EQ (node : *enode , Ival : *elval) 
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var elval : Ivall , lval2 ; 

if (treetocode (node->l , felvall) ) rvalue (felvall) ; 
zpushO ; 

if (treetocode (node->r,&lval2)) rvalue (&lval2) ; 
zpopO ; 
zeqO ; 

lval->sort=L_ONREG ; 
lval->idx=0 ; 
lval->of f set=0; 
lval->typ=T_INT; 
return 0; 

} 

f unc ct_MEQ (node : *enode , Ival : *elval) 
{ 

var elval : Ivall , lval2 ; 

if (treetocode(node->l,&lvall))rvalue(&lvall) ; 
zpushO ; 

if (treetocode (node->r , &lval2) ) rvalue (&lval2) ; 

zpopO ; 
zneO ; 

lval->sort=L_ONREG ; 
lval->idx=0 ; 
lval->of f set=0 ; 
lval->typ=T_INT; 
return 0; 

} 

f unc ct_GT (node : *enode , Ival : *elval) 
{ 

var elval : Ivall , lval2 ; 

if (treetocode(node->l,&lvall)) rvalue (fclvall) ; 
zpushO ; 

if (treetocode (node->r , &lval2) ) rvalue (&lval2) ; 
zpopO ; 

if ( ! issigneddvall .typ) I I !issigned(lval2.typ)) 
ugtO ; 
else 
zgtO ; 

lval->sort=L_ONREG ; 
lval->idx=0; 
lval->offset=0; 
lval->typ=T_INT; 
return 0; 

} 

f unc ct_LT (node : *enode , Ival : *elval) 

{ 

var elval: Ivall, lval2; 

if (treetocode (node->l , fclvall ) ) rvalue (fclvall ) ; 
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zpushO ; 

if (treetocode(node->r,&lval2)) rvalue (&lval2) ; 
zpopO ; 

if ( ! issigneddvall .typ) I I !issigned(lval2.typ)) 

ultO ; 

else 

zltO; 

lval->sort=L_ONREG ; 
lval->idx=0; 
lval->of f set=0 ; 
lval->typ=T_INT; 
return 0; 

} 

f unc ct_GE (node : *enode , Ival : *elval) 
{ 

var elval : Ivall , lval2 ; 

if (treetocode (node->l,&lvall) ) rvalue (felvall) ; 
zpushO ; 

if (treetocode (node->r,&lval2)) rvalue (&lval2) ; 
zpopO ; 

if (! issigneddvall .typ) I I !issigned(lval2.typ)) 

ugeO ; 
else 
zgeO ; 

lval->sort=L_ONREG ; 
lval->idx=0; 
lval->of f set=0 ; 
lval->typ=T_INT; 
return 0; 

} 

f unc ct_LE (node : *enode , Ival : *elval) 
{ 

var elval : Ivall , lval2 ; 

if (treetocode (node->l,&lvall) ) rvalue (felvall) ; 
zpushO ; 

if (treetocode (node->r,&lval2)) rvalue (&lval2) ; 
zpopO ; 

if (! issigneddvall .typ) I I !issigned(lval2.typ)) 

uleO ; 

else 

zleO; 

lval->sort=L_ONREG ; 
lval->idx=0; 
lval->of f set=0 ; 
lval->typ=T_lNT; 
return 0; 



53 



f unc ct_SHL (node : *enode , Ival : *elval) 
{ 

var elval:lvall,lval2; 

if (treetocode (node->l , fclvall ) ) rvalue (fclvall ) ; 
zpushO ; 

if (treetocode (node->r , &lval2) ) rvalue (&lval2) ; 

zpopO ; 

asK); 

lval->sort=L_ONREG ; 
lval->idx=0 ; 
lval->of f set=0 ; 
lval->typ=T_INT; 
return 0; 

} 

f unc ct_SHR(node : *enode , Ival : *elval) 
{ 

var elval:lvall,lval2; 

if (treetocode(node->l ,&lvall) ) rvalue (fclvall) ; 

zpushO ; 

if (treetocode (node->r , &lval2) ) rvalue (&lval2) ; 
zpopO ; 

asr ; 

lval->sort=L_ONREG ; 
lval->idx=0; 
lval->of f set=0 ; 
lval->typ=T_INT; 
return 0; 

> 

f unc ct_MINUS (node : *enode , Ival : *elval) 
{ 

var elval:lvall,lval2; 
var int:isptr; 
isptr=0; 

if (treetocode(node->l,&lvall))rvalue(&lvall) ; 
zpushO ; 

if (treetocode (node->r , &lval2) ) rvalue (&lval2) ; 
zpopO ; 

lval->sort=L_ONREG ; 
lval->idx=0; 
lval->off set=0; 
lval->typ=T_INT; 

if (typtab[lvall.typ] . sort==V_PTR | | 
typtab [Ivall . typ] . sort==V_ARR) 

i 

if (typtab [lval2 . typ] . sort==V_PTR | | 
typtab [lval2 .typ] . sort==V_ARR) 

{ 

zsubO ; 



54 



if (typtab [Ivall .typ] .type!=typtab[lval2.typ] .type) 
error ("subtracting pointers of different types"); 
divconstCgettsize (typtab [Ivall. typ] .type)) ; 
isptr=0 ;/*?*/ 
lval->typ=T_INT ; /*?*/ 

} 

else 

i 

mulregCgettsize (typtab [Ivall. typ] .type) ,/*"7,eax"*/RG_A) ; 
zsubO ; 

lval->typ=lval 1 . typ ; 

} 

} 

else 
i 

if (typtab [lval2. typ] . sort==V_PTR| | 

typtab [lval2 . typ] . sort==V_ARR) 
error ("subtracting a pointer"); 
zsubO ; 

} 

return 0;/*on register*/ 

} 

f unc ct_PLUS (node : *enode , Ival : *elval) 
{ 

var elval:lvall,lval2; 
var intrisptr; 
isptr=0 ; 

if (treetocode(node->l,&lvall)) rvalue (fclvall) ; 
zpushO ; 

if (treet ocode (node->r , &lval2) ) rvalue (&lval2) ; 

lval->sort=L_ONREG ; 

lval->idx=0 ; 

lval->of f set=0 ; 

lval->typ=T_INT; 

if (typtab [Ivall. typ] . sort==V_PTR| | 
typtab [Ivall. typ] . sort==V_ARR) 

i 

mulreg(gettsize (typtab [Ivall .typ] .type) ,/*"°/oeax"*/RG_A) ; 
isptr=l ; 

lval->typ=lval 1 . typ ; 

} 

zpopO ; 

if (typtab [lval2 . typ] . sort==V_PTR | | 
typtab [lval2 . typ] . sort==V_ARR) 

i 

if (isptr)error("cannot add pointer to pointer"); 
mulreg(gettsize(typtab[lval2.typ] .type) ,/*"°/oedx"*/RG_D) ; 
isptr=l ; / *legacy?*/ 
Ival->typ=lval2 . typ ; 
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} 

zaddO ; 

return 0;/*on register*/ 

} 

f unc ct_MUL (node : *enode , Ival : *elval) 
{ 

var elval:lvall,lval2; 

if (treetocode(node->l,&lvall))rvalue(&lvall) ; 
zpushO ; 

if (treet ocode (node->r , &lval2) ) rvalue (&lval2) ; 

zpopO ; 
mult ( ) ; 

lval->sort=L_ONREG ; 
lval->idx=0 ; 
lval->of f set=0 ; 
lval->typ=T_INT; 
return 0; 

} 

f unc ct_DIV (node : *enode , Ival : *elval) 
{ 

var elval:lvall,lval2; 

if (treet ocode (node->l ,&lvall) ) rvalue (fclvall) ; 

zpushO ; 

if (treetocode(node->r,&lval2)) rvalue (&lval2) ; 
zpopO ; 
divO ; 

lval->sort=L_ONREG ; 
lval->idx=0; 
lval->of f set=0 ; 
lval->typ=T_INT; 
return 0; 

} 

f unc ct_REM (node : *enode , Ival : *elval) 
{ 

var elval : Ivall , lval2 ; 

if (treet ocode (node->l,&lvall) ) rvalue (felvall) ; 
zpushO ; 

if (treetocode(node->r,&lval2)) rvalue (&lval2) ; 
zpopO ; 
zmodO ; 

lval->sort=L_ONREG; 
lval->idx=0; 
lval->of f set=G; 
lval->typ=T_INT; 
return ; 

} 

f unc ct_lPP (node : *enode , Ival : *elval) 
{ 

var int : k , sz ; 
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k=treetocode(node->r ,lval) ; 
if ( !k){needlval() ; return 0;} 
if (lval->sort==L_POI) 
i 

zpushO ; 
rvalue (Ival) ; 
lval->sort=L_SP; 

} 

else rvalue (Ival) ; 

if (typtab [lval->typ] . sort==V_PTR) 

sz=gettsize (typtab [lval->typ] .type) ; 

else sz=l; 

increg(sz) ; 

store (Ival) ; 

lval->sort=L_ONREG ; 

lval->idx=0; 

lval->of f set=0; 

return 0; 

} 

f unc ct_lMM (node : *enode , Ival : *elval) 
{ 

var int : k , sz ; 

k=treetocode(node->r,lval) ; 
if ( !k) {needlval ; return O;} 
if (lval->sort==L_POI) 
i 

zpushO ; 
rvalue (Ival) ; 
lval->sort=L_SP; 

> 

else rvalue (Ival) ; 

if (typtab [lval->typ] . sort==V_PTR) 

sz=gettsize (typtab [lval->typ] .type) ; 

else sz=l; 

decreg(sz) ; 

store (Ival) ; 

lval->sort=L_ONREG ; 

lval->idx=0; 

lval->offset=0; 

return 0; 

} 

f unc ct_2PP (node : *enode , Ival : *elval) 
{ 

var int:k,sz; 

k=treetocode(node->r,lval) ; 
if ( !k) -[needlval ; return 0;} 
if (lval->sort==L_POI) 
i 

zpushO ; 
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rvalue (Ival) ; 
lval->sort=L_SP; 

} 

else rvalue (Ival) ; 

if (typtab [lval->typ] . sort==V_PTR) 

sz=gettsize(typtab [lval->typ] .type) ; 

else sz=l; 

incregCsz) ; 

store (Ival) ; 

decreg(sz) ; 

lval->sort=L_ONREG ; 

lval->idx=0 ; 

lval->of f set=0; 

return 0; 

} 

f unc ct_2MM (node : *enode , Ival : *elval) 

{ 

var int:k,sz; 

k=treetocode(node->r ,lval) ; 
if ( !k){iieedlval() ; return O;} 
if (lval->sort==L_POI) 
i 

zpushO ; 
rvalue (Ival) ; 
lval->sort=L_SP; 

} 

else rvalue (Ival) ; 

if (typtab [lval->typ] . sort==V_PTR) 

sz=gett size (typtab [lval->typ] .type) ; 

else sz=l; 

decreg(sz) ; 

store (Ival) ; 

increg(sz) ; 

lval->sort=L_ONREG ; 

lval->idx=0 ; 

lval->of f set=0 ; 

return 0; 

> 

f unc ct_UMINUS (node : *enode , Ival : *elval) 
{ 

var int : k ; 

k=treetocode(node->r,lval) ; 
if (k) rvalue (Ival) ; 
negO ; 

lval->sort=L_ONREG ; 
lval->idx=G; 
lval->of f set=0; 
return ; 
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f unc ct_STAR(node : *enode , Ival : *elval) 
{ 

var int : k ; 

k=treetocode(node->r,lval) ; 

if (lval->sort==L_ID | | lval->sort ! =L_STR) 

i 

if (typtab [lval->typ] . sort ! =V_ARR&&typtab [lval->typ] . sort ! =V_PTR) 

{errorC'need a pointer") ;return k;} 

if (k) rvalue (Ival) ; 

lval->sort=L_POI ; 

lval->typ=typtab [lval->typ] . type ; 

lval->offset=0; 

return 1 ; 

} 

else if (lval->sort==L_STR) 
i 

if (k) rvalue (Ival) ; 
lval->sort=L_P01 ; 
lval->typ=T_CHAR ; 
lval->of f set=0; 
return 1 ; 

} 

else-[error(" error with *pointe") ; return 0;} 

} 

f unc ct_ADDRDIR(node : *enode , Ival : *elval) 
{ 

var int : k ; 

k=treetocode (node , Ival) ; 

if (lval->sort==L_ID&&lval->idx) 

i 

if (lval->idx->sort==S_VARG) 
{ 

/*ot("movl $") ; 
outneime(lval->idx->name) ; 

if (lval->off set) 

{outasm("+") ;outdec(lval->off set) ;} 
outasmC , 7,eax") ; 

nlO ;*/ 

zlda(lval->idx->name ,lval->of f set) ; 

} 

else if (lval->idx->sort==S_VARL) 
{ 

/♦otC'leal "); 

outdec (lval->idx->of f set+lval->of f set) ; 

outasm( " (%ebp) , °/,eax" ) ; 

nlO;*/ 

zlea(lval->idx->off set+lval->of f set) ; 

} 

else if (lval->idx->sort==S_FUNC) 
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{ 

error ("address of function: to be implemented"); 

} 

else error("error taking address"); 

} 

else if (lval->sort==L_NUM) 

error("how to take the address of a number?"); 

else if (lval->sort==L_STR) 

i 

loadlita(lval) ; 

} 

else if (lval->sort==L_POI) 
i 

if (lval->offset) 
{ 

increg(lval->of f set) ; 
lval->off set=0; 

} 

> 

else error("error after &"); 
lval->typ=getptrty (lval->typ) ; 
return ; 

} 

f unc ct_ADDR(node : *enode , Ival : *elval) 
{ 

var int : k ; 

return ct_ADDRDIR(node->r,lval) ; 
k=treetocode(node->r,lval) ; 
if (lval->sort==L_ID&&lval->idx) 
i 

if (lval->idx->sort==S_VARG) 
{ 

/*ot("movl $") ; 
outneime(lval->idx->name) ; 

if (lval->off set) 

{outasm("+") ;outdec(lval->off set) ;} 
outasmC" , 7,eax") ; 

nlO ;*/ 

zlda(lval->idx->name ,lval->of f set) ; 

} 

else if (lval->idx->sort==S_VARL) 
{ 

/*ot("leal "); 

outdec (lval->idx->of f set+lval->of f set) ; 

outasmC " (%ebp) , °/,eax" ) ; 

nlO;*/ 

zlea(lval->idx->off set+lval->of f set) ; 

} 

else if (lval->idx->sort==S_FUNC) 
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{ 

error ("address of function: to be implemented"); 

} 

else error("error taking address"); 

} 

else if (lval->sort==L_NUM) 

error("how to take the address of a number?"); 

else if (lval->sort==L_STR) 

i 

loadlita(lval) ; 

} 

else if (lval->sort==L_POI) 
i 

if (lval->offset) 
{ 

increg(lval->of f set) ; 
lval->off set=0; 

} 

> 

else error("error after &"); 
lval->typ=getptrty (lval->typ) ; 
return ; 

} 

f unc ct_LNOT (node : *enode , Ival : *elval) 
{ 

var int : k ; 

k=treetocode(node->r,lval) ; 
if (k) rvalue (Ival) ; 
InotO ; 

lval->sort=L_ONREG ; 
lval->idx=0; 
lval->of f set=0 ; 
lval->typ=T_INT ; /*logical*/ 
return 0; 

> 

f unc ct_BNOT (node : *enode , Ival : *elval) 
{ 

var int : k ; 

k=treetocode(node->r,lval) ; 
if (k) rvalue (Ival) ; 
bnotO ; 

lval->sort=L_ONREG ; 
lval->idx=0; 
lval->of f set=0; 
return 0; 

} 

f unc ct_FUMC (node : *enode , Ival : *elval) 
{ 

var int : k ; 
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var elval:lvall,lval2; 
var *enode:l,r; 
l=node->l ; 

if (l&&((l->op==OP_LEAF&&l->leaf .vid==L_ID 

&&l->leaf . idx 

&&l->leaf . idx->sort==S_FUNC) 
)) 

i 

var int : nargs ; 
r=node->r ; 
nargs=0 ; 
while (r) 
{ 

k=treetocode (r->l ,&lval2) ; 
if (k) rvalue (&lval2) ; 
zpushO ; 

nargs=nargs+WORDSIZE ; 
r=r->r ; 

} 

zcall (l->leaf . idx->naine) ; 
Zsp=modstk(Zsp+nargs) ; 

} 

else if (l&&l->op==OP_DOT) 
i 

/♦error ("calling of method: to be constructed");*/ 

var int : nargs ; 

r=node->r ; 

nargs=0 ; 

while (r) 

{ 

k=treetocode (r->l , &lval2) ; 
if (k) rvalue (&lval2) ; 
zpushO ; 

nargs=nargs+WORDSIZE ; 
r=r->r ; 

} 

/♦zcall (l->leaf . idx->name) ; */ 

/*fprintf (stderr , "tree: ") ; */ 

/*pretree(l->l,stderr) ;fprintf (stderr, "\n") ;*/ 
k=ct_ADDRDIR(l->l,&lval2) ; 

/*f pr intf ( stderr , " lval2 . sort=7.d , of f set=7.d , typ=7.d\n" , 
lval2 . sort , lval2 . offset , lval2 . typ) ; */ 
if (typtab [lval2 . typ] . sort ! =V_PTR) 
{ 

error ("should be pointer. . . ") ; 
f printf (stderr , "typtab [lval2 .typ] =°/.d\n" , 
typtab [lval2 . typ] . sort) ; 

} 

if (typtab [typtab [lval2 . typ] . type] . sort ! =V_STR) 
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{ 

error ( "methods are for structures ... \n") ; 

} 

if (k) rvalue (&lval2) ; 
zpushO ; 

nargs=nargs+WORDSIZE ; 

var [NAMES I ZE] char : methodname ; 

strep (methodname,typtab[typtab[lval2.typ] .type] .name) ; 

strcat (strcat (methodname ,"."), l->naine) ; /* DANGEROUS ! ! ! FixMe ! */ 

cnmlst->addm(methodnaine) ; 

zcall (methodname) ; 

Zsp=modstk(Zsp+nargs) ; 

} 

else 
i 

error ("function by ptr needs to be implemented"); 
f printf (stderr , 

"l->op=y.d,l->leaf . vid=y.d\n" , 

l->op , l->leaf . vid) ; 

} 

lval->sort=L_ONREG ; 
lval->idx=0; 

lval->of f set=0 ; 

lval->typ=T_INT;/*the result*/ 
return 0; 

> 

f unc ct_DOT (node : *enode , Ival : *elval) 
{ 

var int:k,i; 

/*var elval:lvall,lval2;*/ 
k=treetocode(node->l,lval) ; 

if (!k) 

{error ("bizarre to something on register") ;return k;} 

if (typtab [lval->typ] . sort ! =V_STR) 

{error("'.' is for structures") ; return k;} 

i=f indf iel (node->ncime , lval->typ) ; 

if(!i) 

-[error("no such field") ;prstrct(lval->typ) ; return k;} 
lval->typ=f ieldtab [i] .type; 
lval->of f set=lval->of f set+f ieldtab[i] .offset; 
return k; 

} 

func loadlita(lval : *elval) 

{ 

/*ot("movl $"); 
printlab(stlab) ; 
outstr("+") ; 
outdec (lval->of f set) ; 
outstr(" , '/,eax") ; 
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nlO;*/ 

cloadlita(lval->of f set) ; 

} 

func store (lval:*elval) 

{ 

if (lval->sort==L_ID&&lval->idx) 
i 

if (lval->idx->sort==S_VARG) 
{ 

if (lval->typ==T_INT| | 

typtab[lval->typ] . sort==V_PTR) 
/*ot("movl y.eax, ") ;*/ 
zstow(lval->idx->nEime, lval->of f set) ; 
else if (lval->typ==T_CHAR) 
/*ot("movb y.al, ") ;*/ 
zstob(lval->idx->nEuiie, lval->of f set) ; 
else errorC'error in global storing"); 
/ *outneime (lval->idx->naine) ; 
if (lval->offset) 

{outstr("+") ;outdec(lval->offset) ;> 
nlO;*/ 

} 

else if (lval->idx->sort==S_VARL) 
{ 

if (lval->typ==T_INT| | 

typtab [lval->typ] . sort==V_PTR) 
/*ot("movl y.eax, ") ;*/ 
zstlw(lval->idx->of f set+lval->of f set) ; 
else if (lval->typ==T_CHAR) 
/*ot("movb y.al, ") ;*/ 
zstlb(lval->idx->of f set+lval->of f set) ; 
else errorC'error in local storing"); 
/ *outdec(lval->idx->of f set+lval->of f set) ; 
outasmC" (y.ebp) ") ; 
nlO;*/ 

} 

else error ("don't know how to store"); 

} 

else if (lval->sort==L_SP) 
i 

zpopO ; 

if (typtab [lval->typ] . size==BYTESIZE) /*ot ( "movb y.al , " ) ; */ 
zstob2(lval->off set) ; 

else if (typtab [lval->typ] .size==WORDSIZE)/*ot("inovl Zeax, ");*/ 
zstow2(lval->of f set) ; 

else error("error storing object if strange size"); 
/*outdec(lval->offset) ;outstr(" (y.edx)") ;nl() ;*/ 

> 

else error("how to store?"); 
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func rvalue (Ival : *elval) 
{ 

if (! Ival) 

{error ( "rvalue (0) ") ; return;} 
if (lval->sort==L_NUM) 
loadnum(lval) ; 

else if (lval->sort==L_ID&&lval->idx)/*variable. . .*/ 
getmem(lval) ; 

else if (lval->sort==L_POI) 

loadbyre (Ival) ; 

else if (lval->sort==L_STR) 

i 

loadlita(lval) ; 

} 

else 
i 

fprintf (stderr, "lval->sort=y,d\n" ,lval->sort) ; 
error ("code generator error"); 

} 

} 

func loadbyre (Ival : *elval) 
{ 

if (typtab [lval->typ] . size==BYTESIZE) /*ot ( "movsbl " ) ; */ 
zlbrb(lval->of f set) ; 

else if (typtab [lval->typ] .size==WORDSIZE)/*ot("movl "); 
zlbrw(lval->of f set) ; 

else if (typtab [lval->typ] . sort==V_ARR) /*ot ( "leal " ) ; */ 

zlbra(lval->of f set) ; 

else error("error in loadbyregO ") ; 

/*outdec(lval->off set) ; 

outstr("(*/,eax) , 7,eax") ;nl() ;*/ 

} 

func getinein(lval : *elval) 
{ 

/*trc("getmem") ; */ 
if (lval->typ==T_CHAR) 
< 

/*ot( "movsbl ") ;*/ 

if (lval->idx->sort==S_VARG) 

{ 

zldb(lval->ncmie,lval->off set) ; 
/*outname(lval->name) ; 
if (lval->off set) 
{ 

outasin("+") ; 
outdec(lval->of f set) ; 

} 

outasin(" , 7.eax") ; 
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nlO;*/ 

} 

else if (lval->idx->sort==S_VARL) 
{ 

zldlb(lval->idx->of f set+lval->of f set) ; 
/*outdec(lval->idx->of f set+lval->of f set) ; 
outasmC " (°/oebp) , 7.eax" ) ; 
nlO;*/ 

} 

else errorC'error loading 'char' object"); 

} 

else if (lval->typ==T_INT| | lval->typ==T_INTP 
I I lval->typ==T_CHARP 
I I typtab [lval->typ] . sort==V_PTR) 

i 

/♦otC'movl ");*/ 

if (lval->idx->sort==S_VARG) 

{ 

zldw(lval->ncime,lval->of f set) ; 
/ *outncune (lval->naine) ; 
if (lval->off set) 
{ 

outasm("+") ; 
outdec(lval->of f set) ; 

} 

outasmC , 7,eax") ; 
nlO;*/ 

} 

else if (lval->idx->sort==S_VARL) 
{ 

zldlw(lval->idx->of f set+lval->of f set) ; 
/ *outdec (lval->idx->of f set+lval->of f set) ; 
outasmC (%ebp) , °/.eax" ) ; 
nlO;*/ 

> 

else error ("getmem ?"); 

> 

else if (typtab [lval->typ] . sort==V_ARR) 
i 

if (lval->idx->sort==S_VARG) 
{ 

zlda(lval->ncime,lval->off set) ; 

/♦otC'movl $") ; 

outncune (lval->name) ; 

if (lval->off set) 

{ 

outasm("+") ; 
outdec(lval->of f set) ; 

} 
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outasmC, 7.eax") ;nl() ;*/ 

} 

else if (lval->idx->sort==S_VARL) 
■C 

zlea(lval->idx->of f set+lval->of f set) ; 
/*ot("leal "); 

outdec(lval->idx->of f set+lval->off set) ; 
outasin("(7.ebp) , %eax") ;nl() ;*/ 

} 

else error ("still : how to getmem?"); 

> 

else errorC'again error"); 

} 

func loadnum(lval : *elval) 
{ 

zldn(lval->val) ; 
/*ot("movl $") ; 
outdec (lval->val) ; 
outasmC", %eax"); 
nlO;*/ 

} 

func express! () 
{ 

var *enode:node; 
var elval:lval; 

node=bexptree ; 

f printf (stdout ,"#:") ;pretree (node , stdout) ;f printf (stdout , "\n") ; 
if (treetocode (node , fclval) ) rvalue (fclval) ; 
delenode(node) ; 

} 

func bexptreeO 
{ 

var *enode:node; 
node=hconuna() ; 
return node; 

} 

func hcommalO 
{ 

var *enode:node,newnode; 

node=hierl() ; 

blanks ; 

if(ch()!=',') 

return node; 

while (1) 

i 

if (inatch(",")) 

i 

newnode=getenode ; 
newnode->l=node ; 
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newiiode->r=hierl() ; 
newnode->third=0 ; 
newnode->op=OP_COMMA ; 
node=newnode ; 

> 

else return node; 

> 

} 

func hcommaO 
{ 

var *enode:node,newnode; 

node=hierl ; 

blanks () ; 

if (chO ! = ' , ') 

return node; 

while (1) 

i 

if (matchC',")) 
{ 

newnode=getenode() ; 
newnode->l=node ; 
newnode->r=hcoinma() ; 
newnode->third=0 ; 
newnode->op=OP_COMMA ; 
node=newnode ; 

> 

else return node; 

> 

> 

func hierlO 
{ 

var *enode :node,newnode; 
node=hcond() ; 
if (match("=")) 
< 

newnode=getenode ; 
newnode->l=node ; 
newnode->r=hierl () ; 
newnode->th.ird=0 ; 
newnode->op=OP_ASSIGN ; 
node=newnode ; 

} 

return node; 

> 

func hcondO 
{ 

var *enode :node,newnode; 
node=hlor () ; 
if (matchC'?")) 



i 

newiiode=getenode() ; 
iiewnode->l=node ; 
newiiode->r=hcond() ; 
blanks ; 
if (ImatchC':")) 

errorC":' expected i conditional"); 
newnode->third=hcond() ; 
newnode->op=OP_COND ; 
node=newnode ; 

} 

return node; 

} 

func hlorO 
{ 

var *enode:node,newnode; 

node=liland() ; 

blanks ; 

if (matchC | | ")) 

i 

newnode=getenode () ; 
newnode->l=node ; 
newnode->r=hlor ; 
newnode->third=0 ; 
newiiode->op=OP_LOR ; 
node=newnode ; 

> 

return node; 

> 

func hllorO 
{ 

var *enode :node,newnode; 
node=hlaiid() ; 
blanks () ; 

if (!streq(line+lptr," | | ")) 
return node; 
while(match(" | | ")) 
i 

newnode=getenode () ; 
newnode->l=node ; 
newnode->r=hland() ; 
newnode->th.ird=0 ; 
newiiode->op=OP_LOR ; 
node=newnode ; 

} 

return node; 

> 

func hlcLQdO 
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var *enode:node,newiiode; 

node=libor() ; 

blanks ; 

if (match ("&&")) 

i 

newnode=getenode() ; 
newnode->l=node ; 
newnode->r=hland() ; 
newnode->third=0 ; 
newiiode->op=OP_LAND ; 
node=newnode ; 

} 

return node ; 

} 

func hllandO 
{ 

var *enode:node,newnode; 
node=hbor() ; 
blanks () ; 

if ( ! streqdine+lptr ,"&&") ) 
return node; 
while(match("&&")) 
i 

newnode=getenode () ; 
newnode->l=node ; 
newnode->r=hbor ; 
newnode->th.ird=0 ; 
newnode->op=OP_LAND ; 
node=newnode ; 

> 

return node; 

} 

func hborO 
{ 

var *enode :node,newnode; 
node=hbxor() ; 

if (ch() ! = ' I ' I I streqdine+lptr," | | ")) 
return node ; 
while (1) 
i 

blanks ; 

if (streqdine+lptr," | ")&&! streq(line+lptr , " | | ")) 
{ 

gchO; 

newnode=getenode() ; 
newnode->l=node ; 
newnode->r=hbxor ; 
newnode->third=0 ; 
newnode->op=OP_BOR ; 
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node=newnode ; 

} 

else 

return node; 

> 

} 

func hbxorO 
{ 

var *enode :node .newnode ; 
node=hbcLnd() ; 

blanks () ; 

if (ch() !='-'! I streq(line+lptr, "--")) 
return node; 
while (1) 
i 

blanks ; 

if (streq(line+lptr ,""")&&! streq(line+lptr 
{ 

gchO; 

newnode=getenode() ; 
newnode->l=node ; 
newnode->r=libcind() ; 
newnode->third=0 ; 
newnode->op=OP_BXOR ; 
node=newnode ; 

> 

else return node; 

> 

} 

func hbcindO 
{ 

var *enode :node,newnode; 
node=hequal() ; 
blanks () ; 

if (chO !='&'! I streq(line+lptr, "&&")) 
return node; 
while (1) 
i 

blanks () ; 

if ( ch ()=='&'&&! streq ( 1 ine+lptr ,"&&")) 

i 

gchO; 

newnode=getenode() ; 
newnode->l=node ; 
newnode->r=hequal() ; 
newnode->third=0 ; 
newnode->op=OP_BAND ; 
node=newnode ; 

} 
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else return node; 

} 

} 

func hequalO 

{ 

var *enode:node,newnode; 
node=hgt() ; 
blanks ; 

if ( ! streq(line+lptr , " == " ) && ! streq (line+lptr ,"!=")) 
return node; 
while (1) 
i 

if (inatch("==")) 
{ 

newnode=getenode() ; 
newnode->l=node ; 
newnode->r=hgt ; 
newnode->third=0 ; 
newnode->op=OP_EQ ; 
node=newnode ; 

} 

else if (matchC !=")) 
{ 

newnode=getenode ; 
newnode->l=node ; 
newnode->r=hgt ; 
newnode->third=0 ; 
newnode->op=OP_NEQ ; 
node=newnode ; 

} 

else return node; 

} 

} 

func hgtO 
{ 

var *enode:node,newnode; 
node=hshift() ; 

blanks ; 

if (!streq(line+lptr, "<") 

&& ! streq(line+lptr , ">") 

&&!streq(line+lptr, "<=") 

&&!streq(line+lptr,">=") 

I |streq(line+lptr,"«") 

I I streqdine+lptr, "»")) 
return node; 
while (1) 
i 

if (match("<=")) 
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newiiode=getenode() ; 
newnode->l=node ; 
newnode->r=hshif t () ; 
newnode->third=0 ; 
newnode->op=OP_LE ; 
node=newiiode ; 

} 

else if (inatch(">=")) 
{ 

newnode=getenode() ; 
newnode->l=node ; 
newnode->r=hshif t () ; 
newnode->third=0 ; 
newnode->op=OP_GE; 
node=newnode ; 

} 

else if (streq(line+lptr ,"<")&&! streq (line+lptr ,"«")) 
{ 

gchO; 

newnode=getenode() ; 
newnode->l=node ; 
newnode->r=hshif t ; 
newnode->third=0 ; 
newnode->op=OP_LT ; 
node=newnode ; 

> 

else if (streqCline+lptr ,">")&&! streq (line+lptr ,"»")) 
{ 

gchO; 

newnode=getenode() ; 
newnode->l=node ; 
newnode->r=hshif t ; 
newnode->third=0 ; 
newnode->op=OP_GT ; 
node=newnode ; 

} 

else return node; 

} 

} 

func hshiftO 

{ 

var *enode :node .newnode ; 
node=hplusminus () ; 

blanks () ; 

if ( ! streq (line+lptr , " « " ) && ! streq (line+lptr ,"»")) 
return node; 
while (1) 
i 

if (inatch("«")) 
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{ 

newnode=getenode() ; 
newnode->l=iiode ; 
newnode->r=hplusminus ; 
newnode->third=0 ; 
newiiode->op=OP_SHL ; 
node=newnode ; 

> 

else if (match("»")) 
■C 

newnode=getenode() ; 
newnode->l=node ; 
newnode->r=liplusminus() ; 
newnode->tliird=0 ; 
newiiode->op=OP_SHR; 
node=newnode ; 

> 

else return node; 

> 

} 

func hplusminus 
{ 

Vcir *enode:node,newnode; 
node=hmuldiv () ; 
blanks () ; 

if ((chO ! = ' + ')&&(ch() ! = '-')) 
return node; 
while (1) 
i 

if (match("+")) 
{ 

newnode=getenode() ; 
newnode->l=node ; 
newnode->r=limuldiv() ; 
newnode->third=0 ; 
newnode->op=OP_PLUS ; 
node=newnode ; 

> 

else if (matchC'-")) 
{ 

newnode=getenode() ; 
newnode->l=node ; 
newnode->r=limuldiv() ; 
newnode->third=0 ; 
newnode->op=OP_MINUS ; 
node=newnode ; 

> 

else 

return node; 



} 

} 

func hmuldivO 
{ 

var *enode:node,newiiode; 
node=hunary() ; 
blanks () ; 

if ((chO ! = '*')&&(ch() ! = '/')&&(ch() ! = "/.')) 
return node; 
while (1) 
i 

if (matchC'*")) 
i 

newnode=getenode() ; 
newnode->l=node ; 
newnode->r=liunary() ; 
newnode->third=0 ; 
newnode->op=OP_MUL ; 
node=newnode ; 

> 

else if (mat ch ("/")) 
{ 

newnode=getenode() ; 
newnode->l=node ; 
newnode->r=hunary() ; 
newnode->third=0 ; 
newnode->op=OP_DIV; 
node=newnode ; 

> 

else if (matchC "/.")) 
{ 

newnode=getenode() ; 
newnode->l=node ; 
newnode->r=hunary() ; 
newnode->third=0 ; 
newnode->op=OP_REM; 
node=newnode ; 

> 

else 

return node; 

> 

} 

func hunaryO 
{ 

var *enode :node .newnode ; 

if (match ("++")) 

< 

node=hunary () ; 
newnode=getenode() ; 
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newiiode->l=0 ; 
newnode->r=node ; 
newiiode->third=0 ; 
newnode->op=OP_ IPP ; 
node=newnode ; 
return node; 

} 

else if (matchC — ")) 
i 

node=hunary() ; 
newnode=getenode () ; 
newnode->l=0 ; 
newnode->r=node ; 
newnode->third=0 ; 
newnode->op=OP_lMM; 
node=newnode ; 
return node; 

> 

else if (match("+")) 
< 

node=h.unary () ; 
return node; 

} 

else if (ch =='-'&& ! numeric (line [lptr+1] ) /*match ("-")*/) 
i 

gchO; 

node=h.unary () ; 
newnode=getenode () ; 
newnode->l=0 ; 
newnode->r=node ; 
newnode->third=0 ; 
newnode->op=DP_UMINUS ; 
node=newnode ; 
return node; 

> 

else if (matchC'*")) 
i 

node=hunary ; 
newnode=getenode () ; 
newnode->l=0 ; 
newnode->r=node ; 
newnode->th.ird=0 ; 
newnode->op=OP_STAR ; 
node=newnode ; 
return node ; 

} 

else if (matchC'!")) 
i 

node=hunary() ; 
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newiiode=getenode () ; 
newiiode->l=0 ; 
newnode->r=node ; 
newiiode->third=0 ; 
newnode->op=OP_LNOT ; 
node=newnode ; 
return node; 

} 

else if (matchC'-")) 
i 

node=hunary ; 
newnode=getenode ; 
newnode->l=0 ; 
newnode->r=node ; 
newnode->third=0 ; 
newnode->op=OP_BMOT ; 
node=newnode ; 
return node ; 

> 

else if (match("&")) 
i 

node=hunary() ; 
newnode=getenode () ; 
newnode->l=0 ; 
newnode->r=node ; 
newnode->third=0 ; 
newnode->op=OP_ADDR ; 
node=newnode ; 
return node; 

> 

else 
i 

node=hsubscr () ; 
if (inatch("++")) 
{ 

newnode=getenode() ; 
newnode->l=0 ; 
newnode->r=node ; 
newnode->third=0 ; 
newnode->op=0P_2PP ; 
node=newnode ; 

} 

else if (matchC'--")) 
{ 

newnode=getenode() ; 
newnode->l=0 ; 
newnode->r=node ; 
newnode->third=0 ; 
newnode->op=0P_2MM ; 



node=newnode ; 

} 

return node; 

> 

} 

func hsubscrO 
{ 

var *enode:node,newnode; 
node=primary ; 
blanks () ; 
if ((cli()==' [') I I 

streq(line+lptr ,tlarg) 

I l(ch()=='.') 

I I streq(line+lptr, "->")) 
while (1) 
{ 

if (matchC [")) 

{/* a[i] — > *((a)+(i)) */ 
newnode=getenode() ; 
newnode->l=node ; 
newnode->r=hcomma() ; 
needbracC] ") ; 
newnode->tliird=0 ; 
newnode->op=OP_PLUS ; 
node=getenode() ; 
node->l=0 ; 
node->r=newnode ; 
node->third=0 ; 
node->op=OP_STAR ; 
} 

else if (matchCtlarg/*" ("*/)) 

{ 

newnode=getenode() ; 
newnode->l=node ; 
newnode->r=0 ; 
newnode->third=0 ; 
newnode->op=OP_FUNC ; 
node=newnode ; 
blanks () ; 

whileC ! streqdine+lptr.trarg)) 

{ 

if (endst ()) break; 
newnode=getenode() ; 
newnode->l=hierl () ; 
newnode->r=node->r ; 
newnode->third=0 ; 
newnode->op=DP_LIST; 
node->r=newnode ; 
if ( ImatchC , ") )break; 



> 

needbracCtrarg/*") "*/) ; 
} 

else if (match("->")) 
{/* p->a (*p) . a */ 
var [NAMES I ZE] char :niii; 
if ( ! symneime (nm) ) 

errorC'field name expected"); 
newiiode=geteiiode() ; 
newnode->l=0 ; 
newnode->r=node ; 
iiewiiode->third=0 ; 
newnode->op=OP_STAR ; 
node=getenode ; 
node->l=newnode ; 
node->r=0; 
node->tliird=0 ; 
node->op=OP_DOT; 
strep (node->neune , run) ; 
} 

else if (matchC . ")) 
{ 

var [NAMES I ZE] char: nm; 
if ( ! symnemie (nm) ) 

errorC'field name expected"); 
newnode=getenode() ; 
newnode->l=node ; 
newnode->r=0 ; 
newnode->third=0 ; 
newnode->op=OP_DOT ; 
strep (newnode->name,nm) ; 
node=newnode ; 
} 

else 

return node; 

} 

return node; 

} 

func getenodeO 
{ 

return chkmem(calloc(l,sizeof (enode))) ; 

} 

func delenode(node:*enode) 
{ 

if ( ! node) return; 
delenode(node->l) ; 
delenode (node->r) ; 
delenode (node->third) ; 
free (node) ; 



79 



} 

func primary () 
{ 

var *enode:node; 

var [l]int: num; 

var [NAMES I ZE] char : nm; 

if (match(tlarg) ) 

i 

node=bexptree() ; 
needbrac (trarg) ; 
return node; 

} 

if (amat ch ( " sizeof " , 6) ) 
< 

var int : t , s ; 
needbrac (tlarg) ; 
t=gettypen() ; 
s=gettsize(t) ; 
needbrac (trarg) ; 
node=getenode () ; 
node->l=node->r=node->th.ird=0 ; 
node->op=OP_LEAF ; 
node->leaf .vid=L_NUM; 
node->leaf . val=s ; 
return node; 

} 

if (number (num) ) 
i 

node=getenode () ; 
node->l=node->r=node->th.ird=0 ; 
node->op=OP_LEAF ; 
node->leaf .vid=L_NUM; 
node->leaf . val=num [0] ; 
return node; 

} 

if (pstr (num) ) 
i 

node=getenode() ; 
node->l=node->r=node->th.ird=0 ; 
node->op=OP_LEAF ; 
node->leaf .vid=L_NUM; 
node->leaf . val=num [0] ; 
return node; 

> 

if (symname (nm) ) 
i 

var *ssym:k; 
node=getenode() ; 
node->l=node->r=node->third=0 ; 



iiode->op=OP_LEAF ; 
node->leaf . vid=L_ID ; 
strep (node->name , nm) ; 

if (inethodcls&&inethodidx&& (k=f indf iel (nm .methodcls) ) ) 

{ 

var *enode:ths; 

var *ssyTii:t; 

ths=getenode ; 

ths->l=ths->r=ths->third=0 ; 

ths->op=OP_LEAF; 

ths->leaf . vid=L_ID ; 

if (! (t=fiiidloc("this"))) 

error ("internal error: missing 'this'"); 

ths->leaf . idx=t ; 

strep (ths->nemie , "this") ; 

node->r=ths ; 

node->op=OP_STAR; 

var *enode : newnode ; 

newnode=getenode() ; 

newnode->l=node ; 

newnode->r=0; 

newnode->third=0 ; 

newnode->op=OP_DOT ; 

strep (newnode->name ,nm) ; 

node=newnode ; 

> 

else if (k=f indloe(nm)) 
{ 

node->leaf . idx=k; 
enmlst->addm(nm) ; 

} 

else if (k=findglb(nm)) 
{ 

node->leaf . idx=k; 
enmlst->addm(nm) ; 

} 

else 

{/* undeclared function */ 

k=addloc(nm,S_VARL,l,0,T_INT) ; 

k->sort=S_FUNC; 

k->dfd=0; 

node->leaf . idx=k; 

enmlst->addm(nm) ; 

> 

return node ; 

} 

if (qstr(num) ) 
i 

node=getenode() ; 
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node->l=node->r=node->third=0 ; 
node->op=OP_LEAF ; 
iiode->leaf . vid=L_STR ; 
node->leaf . val=nuiii [0] ; 
return node; 

> 

errorC'wrong expression"); 
return 0; 

} 

func pstr(val:*int) 
{ 

var int : k ; 
var char : c ; 

k=0; 

if (! match (""')) return 0; 
while ( (c=gch() )! =39) 
i 

if (c!=92) 

k=((k&255)«8) + (c&255) ; 

else 

{ 

c=gch() ; 

if ( ! c)break; 

if (c=='n')c=10; 

else if (c=='t')c=9; 

else if (c=='b')c=8; 

else if (c=='f ')c=12; 

k= ( (k&255) «8) + (C&255) ; 

} 

> 

val [0] =k; 

/*fprintf (stderr , "the character :°/.d\n" ,k) 
return 1; 

} 

func qstr(val:*int) 
{ 

var int : k ; 
var char : c ; 
k=0; 

if ( !match(quote) )return 0; 

val [0] =stptr ; 
while(ch() !='"') 
i 

if (!ch())break; 
if (stptr>=STMAX) 
{ 

error ("string space exhausted"); 
while ( ! match (quote) ) if ( ! gch() )breELk; 
return 1; 
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} 

c=gch() ; 

if (c ! =92) litq [stptr++] =c ; 

else 

■C 

c=gch() ; 

if ( ! c) break; 

if (c=='n')c=10; 

else if (c=='tOc=9; 

else if (c=='b')c=8; 

else if (c=='f ')c=12; 

litq [stptr++] =c ; 

} 

} 

gchO; 

litq[stptr++] =0; 
return 1; 

} 

func number (val:*int) 
{ 

var int:k; 

var int : d ; 

var int: minus; 

var char : c ; 

k=minus=l ; 

if (match("Ox"))-[ 

k=0; 

while (numeric (chO) | | ((ch()>='a')&&(ch()<='f '))){ 
c=inbyte() ; 
if (numeric (c) ) {. 
k=(k«4) + (c-'0') ; 
} 

else 
{ 

k=(k«4) + (c-'a'+10) ; 

} 

> 

val [0]=k; 
return 1; 
> 

while (k)-[ 
k=0; 

if (match("+"))k=l; 
if (match("-"))-[ 

minus=-l ; 

k=l; 

} 
> 

if (!numeric(ch()))return 0; 
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while (numeric (ch() ) ) { 
c=inbyte ; 
k=k*10+(c-'0') ; 
> 

if (minus<0)k=(-k) ; 
val [0]=k; 
return 1; 

} 

f unc needbrac (p : *char) 
{ 

if (! match (p)){ 

error ("missing bracket"); 

comment ; 

outstr(p) ; 

nlO; 

> 

} 

func needlvalO 
{ 

error ("must be lvalue"); 

} 

func ns() 
{ 

if (!match(";") ) error ("missing ';'"); 

} 

func issigned(t : int) 
{ 

return (t==T_INT) | | (t==T_CHAR) ; 

} 

func gettsize(t : int) 
{ 

if (t==T_INT) return WORDSIZE; 
else if (t==T_CHAR) return BYTESIZE; 
else if (t==T_INTP) return WORDSIZE; 
else if (t==T_CHARP) return WORDSIZE; 

else if ((t>=F_TYPE)&&(t<typptr)) return typtab[t] .size; 

else 

i 

error (" strange type"); 
return 0; 

> 

} 

/★returns type 'function of a type' */ 

func getfnctype(t : int) 

{ 

if (t>=typptr) 
i 

error ( "getf nctype : unknown type") ; 
return T_INTP; 
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} 

var int : k ; 

f or(k=l;k<typptr;k++) 

if ((typtab[k] . sort==V_FMC)&&(typtab [k] .type==t)) return k; 

k=typget() ; 

typtab [k] . name [0] =0 ; 

typtab[k] .sort=V_FMC; 

typtab [k] .type=t; 

typtab [k] . size=0 ; /*maybe ...*■/ 

return k; 

} 

func typgetO 
{ 

if (typptr>=NUMTYP) 
i 

numtyp=numtyp+NUMTYP ; 

chkmein(typtab=realloc (typtab , sizeof (styp) *numtyp) ) ; 

> 

return typptr++; 

} 

/♦returns pointer to a type */ 
func getptrty (t : int) 

{ 

var int : k ; 

if (t>=typptr){ 

error ("unknown type"); 

return T_INTP; 

> 

k=l; 

while (k<typptr) { 

if ( (typtab [k] .sort==V_PTR)&& (typtab [k] .type==t) ) return k; 

k++; 

} 

if (typptr>=numtyp) { 

/*fprintf (stderr, "reallocating types\n") ;*/ 
numtyp=numtyp+NUMTYP ; 

chkinem(typtab=realloc (typtab , sizeof (styp) *numtyp) ) ; 
> 

typtab [typptr] .naine[0]=0; 
typtab [typptr] .sort=V_PTR; 
typtab [typptr] .type=t; 
typtab [typptr] . size=WORDSIZE; 
return typptr++; 

> 

func cbtypeO 
{ 

var [NAMESIZE] char : sname ; 
blanks ; 

/*fprintf (stderr , "cbtype()\n") ; 
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fprintf (stderr , "line=%s\n" .line) ;*/ 
if (ch()=='*' I |ch()==' [') 
return 1 ; 

if ( ! f symname ( sname ) ) 
return ; 

/*fprintf (stderr , "got a neime :y,s\n, line=°/,s\n" , sncime.line) ; */ 
if ( ! findtyp (sname) ) 
return ; 
return 1 ; 

} 

func gettypenO 
{ 

var [NAMES I ZE] char : tname ; 

var int : k ; 

var int : 1 ; 

var int : t ; 

var int : c ; 

var [1] int : dim; 

trcC'gettypename") ; 

if (amatcliC'cliar" ,4))return T_CHAR; 

if (amatchC'int" ,3))return T_INT; 

if (alpha(ch())){ 

k=l=0; 

while (an(c=line [Iptr+k] ) ){ 
if (k<NAMEMAX) tname [1++] =c ; 
k++; 

> 

comment () ; 
outstr("l=") ; 
outdec(l) ; 
nlO; 

tname [1] =0 ; 
comment () ; 

outstrC'typename: ") ; 
outstr (tname) ; 
nlO; 

if (t=f indtyp (tname) ) { 

lptr=lptr+k; 
comment ; 

outstrC'type handle:"); 

outdec(t) ; 

nlO; 

trc(line+lptr) ; 
return t; 

} 

else 
{ 

error ("unknown type"); 
return T_INT; 
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} 

} 

if (match("*")){ 

if (! (t=gettypen())) return 0; 

k=l; 

while (k<typptr) { 

if ( (typtab [k] . sort==V_PTR)&&(typtab [k] .type==t)) return k; 
k++; 

> 

if (typptr>=numtyp) { 

/*fprintf (stderr, "reallocating types\n") ;*/ 
numtyp=numtyp+NUMTYP ; 

chkmein(typtab=realloc (typtab , sizeof (styp) *nmntyp) ) ; 
} 

typtab [typptr] .name[0]=0; 
typtab [typptr] .sort=V_PTR; 
typtab [typptr] .type=t; 
typtab [typptr] . size=WORDSIZE; 
return typptr++; 
} 

if (matchC [")){ 
if ( ! number (dim) ) {, 

error ("dimension expected"); 

dim[0]=l; 

> 

needbrac("] ") ; 

if (! (t=gettypen() )) return 0; 
k=l; 

while (k<typptr) { 

if ( (typtab [k] . sort==V_ARR)&& (typtab [k] .type==t) 

&& (typtab [k] .dim==dim[0] )) return k; 
k++; 

} 

if (typptr>=numtyp) { 

/*fprintf (stderr , "reallocating types\n") ;*/ 
numtyp=numtyp+NUMTYP ; 

chkmem(typtab=realloc (typtab , sizeof (styp) *numtyp) ) ; 

} 

typtab [typptr] .name[0]=0; 

typtab [typptr] .sort=V_ARR; 

typtab [typptr] .type=t; 

typtab [typptr] .size=gettsize(t)*dim[0] ; 

typtab [typptr] . dim=dim [0] ; 

return typptr++; 

} 

error("type expected"); 
return T_INT; 

} 

func outname(n:*char) 
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{ 

outasm(n) ; 

} 

func inbyteO 
{ 

while (!ch()){ 

if (iseof) return 0; 

insline ; 

preproceO ; 

} 

return gch() ; 

} 

func junkO 
{ 

if (an(inbyte()))while(an(ch()))gch() ; 
else 

while(!an(cli())){ 
if (!ch() ) break; 
gchO ; 

} 

blanks () ; 

} 

func strep (d:*char,s:*char) 
{ 

while (*d++=*s++) ; 

> 

func f indsjrmCsncime : *char , sjrms : *ssyTn,ptr : int) 
{ 

var int : k ; 

/*fprintf (stderr, "sname=°/oS,ptr=°/,d\n" ,sname,ptr) ;*/ 

for(k=0;k<ptr;k++) 

i 

/*fprintf (stderr, "1") ;*/ 

if (strid(sname,syms[k] .name)) 

{return syms+k; f printf (stderr, "2\n") ;} 

/*fprintf (stderr, "2") ;*/ 

> 

return 0; 

} 

func outdec(n:int) 

{ 

if (n<0){ 

out byte ('-'); 

n=-n; 

} 

out int (n) ; 

} 

func outint(n: int) 
{ 



88 



var int : q ; 
q=n/10; 

if (q) outint (q) ; 
outbyte('0'+n7.10) ; 

} 

func error (p: *char) 
{ 

var int:k; 
comment ; 
outstr ("Error: ") ; 

outstr (p) ; 

fprintf (stderr , " >Error :°/os\n 

fprintf (stderr, "7,s\n" .line) ; 
f or(k=lptr;k — ; )fprintf (stderr, 
fprintf (stderr , " ~\n" ) ; 
nlO; 
++errcnt ; 

} 

func reset 
{ 

lptr=0 ; 
line [0] =0; 

} 

func ol(p:*char) 
{ 

ot(p) ; 
nlO; 

} 

func dumplitsO 
{ 

var int : j ; 

var int : k ; 

if (! stptr) return ; 

ot(" .section") ; 

ot(" .rodata") ; 

nlO; 

printlab(stlab) ; 

colO ; 

nlO; 

k=0; 

while (k<stptr) -[ 
def byte ; 
j=10; 

while(j— ){ 

outdec (litq [k++] ) ; 

if(!j|(k>=stptr)){ 

nlO; 

break; 

} 



outbyteC , ') ; 

} 
} 

} 

func defbyteO 
{ 

otC'.byte "); 

} 

func defstoraO 
{ 

ot(" .conun ") ; 

} 

func printmapO 
{ 

var of:*int; 

if ( ! (of =f openCmapname , "w") ) ) 
< 

fprintf (stderr, "can't open map file '/osXn" .mapnaune) ; 
return ; 

> 

var int : s ; 

var *ss3milist:lst; 

f or (lst=glbsyintab . 1st ; 1st ; lst=lst->next) 
i 

fprintf (of , "%-10s\t%d\t%d\n" , lst->sym. name , 
lst->sym. line , 
lst->syin. sort) ; 

> 

f close(of ) ; 

} 

func dumpglbsO 
{ 

var int : s ; 

var *ss3milist:lst; 

f or (lst=glbsyintab . 1st ; 1st ; lst=lst->next) 
i 

if (lst->syin . sort==S_VARG) if (lst->sym . df d) 

{ 

defstoraO ; 

outname(lst->syTii.neime) ; 

comma ; 

s=gettsize(lst->sym.type) ; 
outdec(s) ; 

if (lst->sym.type==T_CHAR)outasm(" , 1") ; 
else 

outasmC ,4") ; 
nlO; 

} 

> 
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func trailer () 
{ 

nlO; 

comment () ; 

outstr ("<<End of compilation>>") ; 
nlO; 

ot(" .ident") ; 
tabO ; 

outstr (quote) ; 
outstr ("T Cmplr") ; 
outstr (quote) ; 
nlO; 

/*tstcg() ;*/ 

} 

func nl() 
{ 

outbyte(lO) ; 

} 

func tabO 
{ 

outbyteO) ; 

} 

func col() 
{ 

outbyte (':'); 

} 

func comma 
{ 

outbyte (' , ') ; 

} 

func comment 
{ 

outbyte('#') ; 
outbyte (' : ') ; 

} 

func ot(p:*char) 
{ 

tabO ; 
outasm(p) ; 

} 

func outbyte (c : char) 
{ 

if ( Itolitstk) return outbytel(c); 
return putlitst(c); 

} 

func outbytel(c:char) 
{ 

if ( ! c) return 0; 



putchar(c) ; 
return c; 

} 

func outasmCp: *char) 
{ 

while (outbyte (*p++) ) ; 

} 

func outstr(p:*char) 
{ 

while (*p) outbyte (*p++) ; 

> 

func symneune (sname : *char) 
{ 

var int : k ; 
var int : 1 ; 
var char : c ; 

blanks () ; 

if (! alpha (ch())) return 0; 
k=l=0; 

while(an(ch())) 
i 

if (k<NAMEMAX) 
{ 

sneone [1++] =gch() ; 
k++; 

> 

else 
{ 

k++; 
gchO; 

} 

> 

sname [1] =0 ; 
return 1; 

> 

func fsymneime (sname : *char) 
{ 

var int:k; 
var int : 1 ; 
var char : c ; 
var int:qptr; 
blanks ; 

if (! alpha (ch())) return 0; 

k=l=0; 

qptr=lptr ; 

/*f printf (stderr , "7.s\n" , line) ; */ 

while (andine [qptr] )) 

i 

/*f printf (stderr , "%s\n" , line) ; */ 



if (k<NAMEMAX) 
{ 

sname [1++] =liiie [qptr++] ; 
k++; 

> 

else 
{ 

k++; 
qptr++ ; 

} 

} 

sname [1] =0 ; 
return 1 ; 

} 

func trc (p : *char) 
{ 

comment () ; 
outstr (p) ; 
nlO; 

} 

2.2 codegen.e 

/* -*- c -*- */ 

/* code generation by E.V. , (C) 2003 */ 

/* 

This program is free software; you can redistribute it and/or modify 
it under the terms of the GNU General Public License as published by 
the Free Software Foundation; either version 2 of the License, or 
(at your option) anj later version. 

This program is distributed in the hope that it will be useful, 
but WITHOUT ANY WARRANTY; without even the implied warranty of 
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 
GNU General Public License for more details. 

You should have received a copy of the GNU General Public License 

along with this program; if not, write to the Free Software 

Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 

*/ 

#include "codegen.he" 
var extern *int:stderr; 
var extern int:stlab; 

func cg_init (this : *scodegen) 
{ 

this->ncodeitems=NCODEITEMS ; 

chkmem(this->codes=calloc (this->ncodeitems , sizeof (scode) ) ) ; 
this->codeptr=0 ; 
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func cg_done (this : *scodegen) 

{ 

if (this->codes) 
i 

var i : int ; 

f or(i=0; i<this->codeptr; i++) 
cd_done(this->codes+i) ; 
free(this->codes) ; 

> 

this->codes=0; 

th.is->codeptr=0 ; 
this->ncodeitems=0 ; 

} 

func cg_getiteiii(this :*scodegen) 
{ 

if (this->codeptr>=this->ncodeiteins) 
< 

th.is->iicodeitems=th.is->ncodeiteins+NCODEITEMS; 
/♦fprintf (stderr , "ncodeitems=%d, reallocating\n" , 

tliis->ncodeitems) ;*/ 

chkmem(this->codes=realloc (this->codes, 

this->ncodeitems*sizeof (scode) ) ) ; 

> 

cd_init (this->codes+th.is->codeptr) ; 
return this->codes+this->codeptr++; 

> 

func cg_print (*scodegen this) 
{ 

var int : i ; 

f or (i=0; i<this->codeptr ; i++) 
cd_write(this->codes+i) ; 

} 

func cg_transf er (*scodegen this,*scodegen dest) 
{ 

/*fprintf (stderr , "transfer ,dest=°/od\n" ,dest) ;*/ 
var int : i ; 

f or(i=0; i<this->codeptr ;++i) 

cg_insert (dest ,this->codes+i) ; 
/*fprintf (stderr," !transfer()\n") ;*/ 

} 

func cg_insert(*scodegen this,*scode s) 
{ 

/*fprintf (stderr, "insert ()\n") ;*/ 

var *scode:d; 

d=cg_getitem(this) ; 

d->code=s->code ; 

d->arg=s->arg ; 

d->reg=s->reg; 

if (s->str) 
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d->str=strdyn(s->str) ; 

else 

d->str=0; 

/*fprintf (stderr, " ! insert ()\n") ;*/ 

> 

func cd_write(*scode:this) 
{ 

if (this->code==CD_ZCALL) 
i 

otC'call "); 
outname(this->str) ; 
nlO; 

} 

else if (this->code==CD_LAB) 
i 

printlab(this->arg) ; 

colO ; 

nlO; 

> 

else if (this->code==CD_ JUMP) 
i 

otC'jmp ") ; 
priiitlab(this->arg) ; 
nlO; 

} 

else if (this->code==CD_TESTJUMP) 
i 

olC'testl %eax, 7.eax"); 

otC'je"); 

tabO ; 

printlab(this->arg) ; 
nlO; 

} 

else if (this->code==CD_TESTMEJUMP) 
< 

OlC'testl 7.eax, y.eax"); 
otC'jne") ; 

tabO ; 

priiitlab(this->arg) ; 
nlO; 

} 

else if (this->code==CD_NEG) 
i 

olC'negl %eax") ; 

} 

else if (this->code==CD_LNOT) 
i 

olC'testl y.eax, y.eax" ) ; 
olC'sete y.al") ; 



olC'movzbl 7.al, %eax"); 

> 

else if (this->code==CD_BNOT) 
i 

olC'notl y.eax") ; 

> 

else if (this->code==CD_EQ) 
{ 

otC'cmpl") ; 
ot("%eax, %edx"); 
nlO; 

otC'sete") ; 

ot("%al"); 

nlO; 

otC'movzbl") ; 
ot("%al, y.eax"); 
nlO; 

} 

else if (this->code==CD_NEQ) 
< 

OtC'cmpl") ; 

ot(" y.eax, y.edx"); 

nlO; 

ot("setiie") ; 

ot("y.al"); 

nlO; 

ot("movzbl") ; 
ot("y.al, y.eax"); 
nlO; 

> 

else if (this->code==CD_ZGE) 
i 

ot("cinpl") ; 

ot( "y.eax, y.edx"); 

nlO; 

ot("setge") ; 
ot("y.al") ; 
nlO; 

ot("movzbl") ; 
ot("y.al, y.eax"); 
nlO; 

} 

else if (this->code==CD_UGE) 
i 

ot("cmpl") ; 

ot( "y.eax, y.edx"); 

nlO; 

ot(" setae") ; 
ot("y.al"); 



nlO; 

otC'movzbl") ; 
ot("7.al, 7.eax"); 
nlO; 

} 

else if (this->code==CD_ZLE) 
i 

otC'cmpl") ; 
ot("%eax, %edx"); 
nlO; 

otC'setle") ; 

ot("7.al"); 

nlO; 

OtC'movzbl") ; 
ot("7.al, 7.eax"); 
nlO; 

> 

else if (this->code==CD_ULE) 
i 

OtC'cmpl") ; 
ot("y.eax, 7.edx"); 
nlO; 

otC'setbe") ; 

ot("7.al"); 

nlO; 

OtC'movzbl") ; 
ot("y.al, y.eax"); 
nlO; 

} 

else if (this->code==CD_ZLT) 
i 

OtC'cmpl") ; 
ot("%eax, y.edx"); 
nlO; 

otC'setl") ; 

ot("7.al"); 

nlO; 

OtC'movzbl") ; 
ot("y.al, y.eax"); 
nlO; 

} 

else if (this->code==CD_ULT) 
i 

OtC'cmpl") ; 

ot ( " y.eax , y.edx " ) ; 

nlO; 

otC'setb") ; 

ot("y.al"); 

nlO; 



otC'movzbl") ; 
ot("7,al, %eax"); 
nlO; 

} 

else if (this->code==CD_ZGT) 
i 

otC'cmpl") ; 
ot("7.eax, y.edx"); 
nlO; 

otC'setg") ; 

otcy.al"); 

nlO; 

OtC'movzbl") ; 
ot("7.al, %eax"); 
nlO; 

} 

else if (this->code==CD_UGT) 
i 

OtC'cmpl") ; 
ot("7.eax, y.edx"); 
nlO; 

ot("seta") ; 

otCy.al"); 

nlO; 

ot("movzbl") ; 
ot("y.al, y.eax"); 
nlO; 

> 

else if (this->code==CD_B0R2REGS) 
i 

ol("orl y.edx, y.eax") ; 

} 

else if (this->code==CD_BX0R2REGS) 
i 

ol("xorl y.edx, y.eax") ; 

} 

else if (this->code==CD_BAND2REGS) 
ol("andl y.edx, y.eax"); 

} 

else if (this->code==CD_ADD2REGS) 
i 

ol("addl y.edx, y.eax") ; 

} 

else if (this->code==CD_SUB2REGS) 
i 

ol("subl y.eax, y.edx") ; 
ol("movl y.edx, y.eax"); 



else if (this->code==CD_MUL2REGS) 
olC'imull %edx"); 

} 

else if (this->code==CD_DIV2REGS) 
i 

olC'xchgl %eax, 7.edx"); 
olC'movl y.edx, 7.ecx"); 
olC'cltd") ; 
olC'idivl y.ecx") ; 

} 

else if (this->code==CD_M0D2REGS) 
i 

olC'xchgl y.eax, '/.edx"); 
OlC'movl %edx, "/.ecx"); 
OlC'cltd") ; 
OlC'idivl y.ecx") ; 
olC'movl y.edx, y.eax"); 

> 

else if (this->code==CD_STKENTER) 
i 

ol("pushl y.ebp") ; 
ol("movl y.esp, y.ebp") ; 

} 

else if (this->code==CD_STKLEAVE) 
i 

olC'movl y.ebp, y.esp"); 
ol("popl y.ebp") ; 

} 

else if (this->code==CD_INCREG) 
i 

if (this->arg>0) 
{ 

if (this->arg<3) 
while (this->arg — ) 
ol("iiicl y.eax"); 
else 
{ 

ot("addl $"); 
outdec(this->arg) ; 
outstrC", y.eax"); 
nlO; 

} 

} 

} 

else if (this->code==CD_DECREG) 
i 

if (this->arg>0) 



if (this->arg<3) 
while (this->arg — ) 
olC'decl 7.eax"); 
else 
{ 

otC'subl $"); 
outdec(tliis->arg) ; 
outstrC, %eax"); 
nlO; 

} 

} 

} 

else if (this->code==CD_MODSTK) 
< 

if (this->arg>0) 
{ 

otC'addl $") ; 
outdec(this->arg) ; 
outasmC, 7.esp"); 
nlO; 

} 

else if (this->arg<0) 
{ 

OtC'subl $"); 
outdec(-this->arg) ; 
outasmC, 7.esp"); 
nlO; 

} 

} 

else if (this->code==CD_SHL) 
i 

olC'movl y.eax, 7.ecx") ; 
olC'movl 7.edx, 7.eax"); 
olC'sall 7.cl, 7.eax") ; 

> 

else if (this->code==CD_ASR) 
i 

olC'movl 7.eax, 7.ecx") ; 
OlC'movl 7.edx, 7.eax"); 
olC'sarl 7.cl, 7.eax") ; 

} 

else if (this->code==CD_SHR) 
i 

olC'movl 7oeax, 7oecx"); 
olC'movl 7«edx, 7oeax"); 
olC'shrl 7.cl, 7.eax") ; 

> 

else if (this->code==CD_MULREG) 



xinulreg(this->arg,this->reg[regnames] ) ; 

> 

else if (this->code==CD_DIVCONST) 
i 

xdivconst(this->arg) ; 

> 

else if (this->code==CD_PUSH) 
{ 

olC'pushl %eax"); 

} 

else if (this->code==CD_POP) 
i 

olC'popl y.edx") ; 

} 

else if (this->code==CD_RET) 
i 

olC'ret") ; 

> 

else if (this->code==CD_LDLIT) 
< 

otC'movl $"); 
printlab(stlab) ; 
outstr ("+") ; 
outdec(this->arg) ; 
outstrC, %eax"); 
nlO; 

} 

else if (this->code==CD_LDN) 
< 

if (this->arg==0) 
olC'xorl Zeax, 7.eax"); 
else 
{ 

OtC'movl $"); 
outdec (this->arg) ; 
outstr (", y.eax"); 
nlO; 

} 

> 

else if (this->code==CD_LDA) 
i 

OtC'movl $"); 
outname(this->str) ; 

if (this->arg) 

■[outasm(" + ") ; outdec (this->arg) ;} 

outasmC , °/oeax") ; 

nlO; 

> 

else if (this->code==CD_LEA) 
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i 

otC'leal "); 
outdec(this->arg) ; 
outasmC (%ebp) , 7.eax") ; 
nlO; 

> 

else if (this->code==CD_STOW) 
{ 

otC'movl %eax, "); 
outname(this->str) ; 

if (this->arg) 

■Coutstr("+") ;outdec(this->arg) ;} 
nlO; 

} 

else if (this->code==CD_STOB) 
i 

otC'movb 7.al, ") ; 
outname(this->str) ; 
if (this->arg) 

{outstr("+") ;outdec(this->arg) ;} 
nlO; 

} 

else if (this->code==CD_ST0B2) 
i 

OtC'movb %al, ") ; 

outdec (this->arg) ; 
outstrC'C/.edx)") ;nl() ; 

> 

else if (this->code==CD_ST0W2) 
i 

OtC'movl %eax, ") ; 
outdec (this->arg) ; 
outstrC'C/.edx)") ;nl() ; 

} 

else if (this->code==CD_STLW) 
i 

OtC'movl y.eax, ") ; 

outdec (this->arg) ;outasm(" (%ebp)") ;nl() ; 

> 

else if (this->code==CD_STLB) 
i 

OtC'movb y.al, "); 

outdec (this->arg) ;outasm(" (%ebp)") ;nl() ; 

} 

else if (this->code==CD_LBRB) 
i 

otC'movsbl ") ; 

outdec (th.is->arg) ; 

outstrC' C/.eax) , 7.eax") ;nl() ; 
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else if (this->code==CD_LBRW) 
i 

otC'movl "); 
outdec(this->arg) ; 
outstr("(7.eax) , "/.eax") ;nl() ; 

} 

else if (this->code==CD_LBRA) 
i 

otC'leal ") ; 

outdec(this->arg) ; 
outstr("(7.eax) , "/.eax") ;nl() ; 

} 

else if (this->code==CD_LDW) 
i 

OtC'movl ") ; 

outname (this->str) ; 

if (th.is->arg) 

{ 

outasm(" + ") ; 
outdec(this->arg) ; 

} 

outasmC, Zeax") ;iil() ; 

} 

else if (this->code==CD_LDB) 
i 

otC'movsbl ") ; 
outname (this->str) ; 
if (this->arg) 
{ 

outasin("+") ; 
outdec(this->arg) ; 

} 

outasmC , %eax") ;nl() ; 

> 

else if (this->code==CD_LDLW) 
i 

OtC'movl ") ; 
outdec(th.is->arg) ; 
outasmC (Zebp) , 7.eax") ; 
nlO; 

} 

else if (this->code==CD_LDLB) 
< 

OtC'movsbl ") ; 
outdec(this->arg) ; 
outasmC C/oebp) , 7.eax") ; 
nlO; 



else if (this->code==CD_IGNORE) 



else 
i 

fprintf (stderr , "7.d " ,this->code) ; 
error ("unknown opcode"); 

> 

} 

func xdivcoiist(k:int) 
{ 

var int : 1 ; 

if (k==l) return ; 

if(!k){ 

error ("division by zero"); 

return ; 

> 

1=1; 

while (K15) if (k==(l«l)){ 

ot("sarl $"); 

outdec (1) ; 

outstr(" , y.eax") ; 

nlO; 

return ; 

} 

else 
1++; 

ol("cltd") ; 
ot("divl $"); 
outdec (k) ; 
nlO; 

} 

func xmulreg(k:int,s:*char) 
{ 

var int : 1 ; 

if (k==l)return ; 

else 

if (k==0)-[ 

ot("xorl "); 
outstr (s) ; 
outstr(", "); 
outstr (s) ; 
nlO; 

} 

else 
{ 

1=1; 

while (K15) if (k==(l«l)){ 
ot("sall $"); 
outdec (1) ; 
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outstrC, "); 
outstr(s) ; 
nlO; 
return ; 

> 

else 
1++; 

> 

otC'imull $"); 
outdec(k) ; 
outstrC, "); 
outstr(s) ; 
nlO; 

} 

func cci_init (*scode : this) 
{ 

this->cod.e=0 ; 
this->arg=0 ; 
this->reg=RG_A ; 
this->str=0; 

} 

func cd_done(this:*scode) 
{ 

if (this->str) 
free(this->str) ; 
this->code=0 ; 
this->arg=0 ; 
this->reg=RG_A ; 
this->str=0; 

} 

func strdyn(*char : s) 
{ 

var int : 1 ; 
var *char:res; 

l=strlen(s) ; 

chkmem(res=calloc(l+l .sizeof (char) ) ) ; 
strep (res, s) ; 
return res; 

} 

func mulreg (k : int , int s) 

{ 

var *scode:cd; 
cd=cg_getitem(ccg) ; 
cd->code=CD_MULREG; 
cd->arg=k; 
cd->reg=s ; 

} 

func increg(k: int) 
{ 
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var *scode:cd; 
cd.=cg_getiteiii(ccg) ; 
cd->code=CD_INCREG ; 
cd->arg=k ; 

} 

func decregCk: int) 
{ 

var *scode:cd; 
cd=cg_getitem(ccg) ; 
cd->code=CD_DECREG ; 
cd->arg=k; 

} 

func multO 
{ 

var *scode:cd; 
cd=cg_getitem(ccg) ; 
cd->code=CD_MUL2REGS ; 

} 

func div() 
{ 

var *scode:cd; 
cd=cg_getitem(ccg) ; 
cd->code=CD_DIV2REGS ; 

} 

func zmodO 
{ 

Vcir *scode:cd; 
cd=cg_getiteni(ccg) ; 
cd->code=CD_M0D2REGS ; 

} 

func zpopO 
{ 

var *scode:cd; 
cd=cg_getitem(ccg) ; 
cd->code=CD_POP; 
Zsp=Zsp+4; 

} 

func zpushO 
{ 

var *scode:cd; 
cd=cg_getitem(ccg) ; 
cd->code=CD_PUSH; 
Zsp=Zsp-4; 

> 

func zretO 
{ 

var *scode:cd; 
cd=cg_getitem(ccg) ; 
cd->code=CD_RET; 



func divconst(int k) 
{ 

var *scode:cd; 

cd=cg_getitem(ccg) ; 
cd->code=CD_DIVCONST; 
cd->arg=k ; 

> 

func zaddO 
{ 

var *scode:cd; 
cd=cg_getitem(ccg) ; 
cd->code=CD_ADD2REGS ; 

> 

func zsubO 
{ 

var *scode:cd; 
cd=cg_getitem(ccg) ; 
cd->code=CD_SUB2REGS ; 

} 

func negO 
{ 

var *scode:cd; 
cd=cg_getitem(ccg) ; 
cd->code=CD_NEG; 

> 

func zeqO 
{ 

var *scode:cd; 
cd=cg_getitem(ccg) ; 
cd->code=CD_EQ ; 

} 

func zneO 
{ 

var *scode:cd; 
cd=cg_getitem(ccg) ; 
cd->code=CD_NEQ ; 

> 

func zgeO 
{ 

var *scode:cd; 
cd=cg_getitem(ccg) ; 
cd->code=CD_ZGE; 

} 

func ugeO 
{ 

var *scode:cd; 
cd=cg_getitem(ccg) ; 
cd->code=CD_UGE; 



func uleO 
{ 

var *scode:cd; 

cd=cg_getitem(ccg) ; 
cd->code=CD_ULE; 

} 

func zleO 
{ 

var *scode:cd; 

cd=cg_getitem(ccg) ; 
cd->code=CD_ZLE; 

} 

func ultO 
{ 

var *scode:cd; 

cd=cg_getitem(ccg) ; 
cd->code=CD_ULT; 

} 

func zltO 
{ 

var *scode:cd; 

cd=cg_getitem(ccg) ; 
cd->code=CD_ZLT; 

} 

func ugtO 
{ 

var *scode:cd; 

cd=cg_getitem(ccg) ; 
cd->code=CD_UGT; 

} 

func zgtO 
{ 

var *scode:cd; 

cd=cg_getitem(ccg) ; 
cd->code=CD_ZGT; 

} 

func zor() 
{ 

var *scode:cd; 

cd=cg_getitem(ccg) ; 
cd->code=CD_B0R2REGS ; 

} 

func zxorO 
{ 

var *scode:cd; 

cd=cg_getitem(ccg) ; 
cd->code=CD_BX0R2REGS ; 



func zandO 
{ 

var *scode:cd; 
cd=cg_getitem(ccg) ; 
cd->code=CD_BAND2REGS ; 

} 

func asr() 
{ 

var *scode:cd; 
cd=cg_getitem(ccg) ; 
cd->code=CD_ASR; 

} 

func asl() 
{ 

var *scode:cd; 
cd=cg_getitem(ccg) ; 
cd->code=CD_SHL; 

} 

func InotO 
{ 

var *scode:cd; 
cd=cg_getitem(ccg) ; 
cd->code=CD_LNOT ; 

} 

func bnotO 
{ 

Vcir *scode:cd; 
cd=cg_getiteni(ccg) ; 
cd->code=CD_BNOT ; 

} 

func testjump (label : int) 

{ 

var *scode:cd; 
cd=cg_getitem(ccg) ; 
cd->code=CD_TESTJUMP; 
cd->arg=label ; 

} 

func testnejump (label: int) 
{ 

var *scode:cd; 

cd=cg_getitem(ccg) ; 
cd->code=CD_TESTNEJUMP ; 
cd->arg=label ; 

> 

func jump (label : int) 
{ 

var *scode:cd; 
cd=cg_getitem(ccg) ; 
cd->code=CD_JUMP; 



cd->arg=label ; 

} 

func zcall(siiame:*char) 
{ 

var *scode:cd; 
cd=cg_getitem(ccg) ; 
cd->code=CD_ZCALL ; 
cd->str=strdyn(sname) ; 

} 

func cmodstkCk: int) 
{ 

var *scode:cd; 
cd=cg_getitem(ccg) ; 
cd->code=CD_MODSTK; 
cd->arg=k; 

} 

func zenterO 
{ 

var *scode:cd; 

cd=cg_getitem(ccg) ; 
cd->code=CD_STKENTER; 

} 

func zleaveO 
{ 

var *scode:cd; 

cd=cg_getitem(ccg) ; 
cd->code=CD_STKLEAVE; 

} 

func clab(int label) 
{ 

var *scode:cd; 
cd=cg_getitem(ccg) ; 
cd->code=CD_LAB; 
cd->arg=label ; 

> 

func cloadlitaCof f s : int) 
{ 

var *scode:cd; 
cd=cg_getitem(ccg) ; 
cd->code=CD_LDLIT ; 
cd->arg=off s; 

} 

func zldn(k:int) 

{ 

var *scode:cd; 
cd=cg_getitem(ccg) ; 
cd->code=CD_LDN; 
cd->arg=k; 

} 



func zlda(*char :name , int offset) 
{ 

var *scode:cd; 
cd=cg_getiteiii(ccg) ; 
cd->code=CD_LDA; 
cd->str=strdyn(naine) ; 
cd->arg=of f set ; 

} 

func zleaCof f set : int) 
{ 

var *scode:cd; 
cd=cg_getitem(ccg) ; 
cd->code=CD_LEA ; 
cd->arg=of f set ; 

} 

func zstow(*char:name,offset:int) 

{ 

var *scode:cd; 
cd=cg_getitem(ccg) ; 
cd->code=CD_STOW; 
cd->str=strdyn(name) ; 
cd->arg=of f set ; 

} 

func zstob(*char:ncime,offset:int) 
{ 

var *scode:cd; 
cd=cg_getitem(ccg) ; 
cd->code=CD_STOB; 
cd->str=strdyn(name) ; 
cd->arg=of f set ; 

} 

func zstlw(int offset) 
{ 

var *scode:cd; 
cd=cg_getitem(ccg) ; 
cd->code=CD_STLW; 
cd->arg=of f set ; 

} 

func zstlb(int offset) 
{ 

var *scode:cd; 
cd=cg_getitem(ccg) ; 
cd->code=CD_STLB; 
cd->arg=of f set ; 

} 

func zlbrw(of f set : int) 
{ 

var *scode:cd; 
cd=cg_getitem(ccg) ; 



cd->code=CD_LBRW ; 
cd->arg=of f set ; 

} 

func zlbrbCof f set : int) 

{ 

var *scode:cd; 
cd=cg_getitem(ccg) ; 
cd->code=CD_LBRB ; 
cd->arg=of f set ; 

} 

func zlbraCof f set : int) 
{ 

var *scode:cd; 

cd=cg_getitem(ccg) ; 
cd->code=CD_LBRA ; 
cd->arg=of f set ; 

} 

func zldw (* char rnarnie , int offset) 
{ 

var *scode:cd; 
cd=cg_getitem(ccg) ; 
cd->code=CD_LDW; 
cd->str=strdyn(name) ; 
cd->arg=of f set ; 

} 

func zldb(* char: name, int offset) 
{ 

var *scode:cd; 
cd=cg_getitem(ccg) ; 
cd->code=CD_LDB; 
cd->str=strdyn(name) ; 
cd->arg=of f set ; 

} 

func zldlw(int offset) 
{ 

var *scode:cd; 
cd=cg_getitem(ccg) ; 
cd->code=CD_LDLW; 
cd->arg=of f set ; 

} 

func zldlb(int offset) 
{ 

var *scode:cd; 

cd=cg_getitem(ccg) ; 
cd->code=CD_LDLB ; 
cd->arg=of f set ; 

> 

func zstow2(int offset) 



var *scode:cd; 
cd.=cg_getitem(ccg) ; 
cd->code=CD_ST0W2 ; 
cd->arg=of f set ; 

} 

func zstob2(iiit offset) 
{ 

var *scode:cd; 
cd=cg_getitem(ccg) ; 
cd->code=CD_ST0B2 ; 
cd->arg=of f set ; 



func tstcgO 
{ 

var scodegen:cg; 
cg_init (&cg) ; 
var *scode:cd; 
cd=cg_getitem(&cg) ; 
cd->code=CD_LAB; 
cd->arg=19; 
cd=cg_getitem(&cg) ; 
cd->code=CD_ZCALL; 
cd->str=strdyn("function2") ; 
cd=cg_getitem(&cg) ; 
cd->code=CD_TEST JUMP ; 
cd->arg=19; 
cd=cg_getitem(&cg) ; 
cd->code=CD_TESTNE JUMP ; 
cd->arg=20 ; 
cg_print (&cg) ; 
cg_done(&cg) ; 

} 

var **char :regnames; 
var *scodegeii: ccg; 
var scodegen : cgglb ; 
func icodegenO 
{ 

/*f printf (stderr , "icodegenO \n" ) ; */ 

chkinem(regnaines=calloc (4 , sizeof (*char) ) ) ; 

regnames [RG_A] ="7.eax" ; 

regnames [RG_B] ="7.ebx" ; 

regnames [RG_C] ="'/,ecx" ; 

regnames [RG_D] ="'/,edx" ; 

ccg=&cgglb; 

cg_init(ccg) ; 

/*f printf (stderr , "ccg=°/.d\n" , ccg) ; */ 

} 

func dcodegenO 
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{ 

/*fprintf (stderr, "dcodegen()\n") ; */ 

/*f printf (stderr , "ccg=yod\n" , ccg) ; */ 

/*f printf (stderr, "ccg. codeptr=%d\n" , ccg->codeptr) ; */ 

cg_print (ccg) ; 

cg_done (ccg) ; 

if (regnames) 

free(regnaines) ; 

} 

2.3 grph.e 

/* -*- c -*- */ 

/* The language compiler by E.V., (C) 2003 */ 

/* graphing module */ 

/* 

This prograim is free software; you can redistribute it and/or modify 
it under the terms of the GNU General Public License as published by 
the Free Software Foundation; either version 2 of the License, or 
(at your option) any later version. 

This program is distributed in the hope that it will be useful, 
but WITHOUT ANY WARRANTY; without even the implied warranty of 
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 
GNU General Public License for more details. 

You should have received a copy of the GNU General Public License 

along with this program; if not, write to the Free Software 

Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 

*/ 

#include "tlcingc.he" 
var *int : grphxof ; 
struct ssq 
{ 

[NAMESIZE] char name; 
int x,y; 

*snamelist nmlst; 
func draw; 

}; 

#define SQNUM 300 
var grsq: [SQNUM] ssq; 
var grsqbx , grsqby : int ; 
var int:grsqptr; 

var grsqx , grsqy , grsqstepx , grsqstepy : int ; 
func grsqadd(*char:ncmie,*snamelist:nmlst) 
{ 

if (grsqptr>=SQNUM)-[ error ("graphing table full") ; return;} 
var int : i ; 

strep (grsq [grsqptr] .name, name) ; 
grsq [grsqptr] .ninlst=nmlst; 
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grsqCgrsqptr] .x=grsqx; 
grsq[grsqptr] .y=grsqy; 
grsqx=grsqx+grsqstepx ; 
grsqy=grsqy+grsqstepy ; 

if (grsqstepx>0&&grsqx>/*-grsqy*/grsqbx) 
{grsqstepy=grsqstepx ; grsqstepx=0 ; grsqbx=grsqbx/*+ll*/ ; } 
else if (grsqstepx<0&&-grsqx>/*grsqy*/grsqbx) 
{grsqstepy=grsqstepx ; grsqstepx=0 ; grsqbx=grsqbx+ll ; }■ 
else if (grsqstepy>0&&grsqy>/*grsqx*/grsqby) 
{grsqstepx=-grsqstepy ; grsqstepy=0 ; grsqby=grsqby/*+ll*/ ; } 
else if (grsqstepy<0&&-grsqy>grsqby/ *-grsqx*/) 
{grsqstepx=-grsqstepy ;grsqstepy=0;grsqby=grsqby+ll ; } 

return grsqptr++; 

} 

func grsqf ind(*char s) 

{ 

var int : i ; 

f or(i=0; i<grsqptr; i++) 
if (strid(grsq[i] .name.s)) 

return i; 
return i ; 

> 

method ssq.drawO 
{ 

f printf (grphxof , "set arrow from 7od,7od to °/A,7A noheadXn" ,x-5,y-5,x+5,y-5) ; 
f printf (grphxof , "set arrow from "/od/Zod to 7«d,y,d nohead\n" ,x+5,y-5,x+5,y+5) ; 
fprintf (grphxof , "set arrow from %d,7.d to 7.d,7,d nohead\n" ,x+5,y+5,x-5,y+5) ; 
f printf (grphxof , "set arrow from 7od,7od to 7od,7„d noheadXn" ,x-5,y+5,x-5,y-5) ; 
fprintf (grphxof , "set label \"7os\" at 7od,7od center f ont\"Helvetica,5\"\n" ,naine,x,y) ; 

} 

func printgraphO 
{ 

Vcir of:*int; 

if ( ! (of =f open(graphname, "w"))) 
i 

fprintf (stderr, "can't open graph file 7oS\n" .graphname) ; 
return ; 

> 

grsqbx=0 ; 
grsqby=0 ; 
grphxof =of ; 
grsqptr=0 ; 
grsqx=grsqy=0 ; 
grsqstepx=ll ; grsqstepy=0 ; 

fprintf (grphxof , "set terminal postscript color solid\n"); 
fprintf (grphxof , "set noborder\n") ; 
fprintf (grphxof , "set noxtics\n") ; 
fprintf (grphxof , "set noytics\n") ; 
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f printf (grplixof , "set nokey\n") ; 
var *ssymlist : 1st ; 

f or (lst=glbsymtab . 1st ; 1st ; lst=lst->next) 
i 

if (lst->syin.nmlst) 
{ 

var int : i ; 

i=grsqadd(lst->sym.naine, lst->syin.nmlst) ; 
/*grsq[i] .drawO ;*/ 

} 

if (0)f printf (of , "7.-10s\t%d\ty.d\n {" ,lst->syin.name, 

lst->sym.line, 

lst->syin. sort) ; 
if (0&&lst->syin . nmlst ) 
{ 

var *snamenode:q; 
q=lst->syiii.iimlst->lst ; 
while (q) 
{ 

f printf (of , "7oS" ,q->name) ; 
if (q->next) f printf (of ,","); 
q=q->next ; 

} 

} 

if (O)fprintf (of ,"}\n") ; 

} 

var int : i ; 

f or(i=0; i<grsqptr; i++) 
i 

var *snamenode : q; 
var int : j ; 

for (q=grsq [i] . nmlst->lst ; q ; q=q->next ) 
{ 

j=grsqf ind(q->naine) ; 

if (j<grsqptr) 

{ 

fprintf (grphxof ,"set arrow from 7.d,7.d to 7.d,7.d nohead It 2 Iw 0.2\n", 
grsq[i] .x,grsq[i] .y,grsq[j] .x,grsq[j] .y) ; 

} 

} 

> 

f or (i=0 ; Kgrsqptr ; i++) 
{ 

grsq[i] .drawO ; 

} 

fprintf (grphxof , "plot [7.d:7.d] [7.d:7.d] \"datO .dat\" " , -grsqbx-11 ,grsqbx+ll , 

-grsqby-31,grsqby+31) ; 
f close (of) ; 
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2.4 tlangc.he 

/* -*- c */ 

/* The language compiler definitions by E.V., (C) 2003 */ 

/* 

This progrEim is free software; you can redistribute it and/or modify 
it under the terms of the GNU General Public License as published by 
the Free Software Foundation; either version 2 of the License, or 
(at your option) any later version. 

This program is distributed in the hope that it will be useful, 

but WITHOUT ANY WARRANTY; without even the implied warranty of 
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 
GNU General Public License for more details. 

You should have received a copy of the GNU General Public License 

along with this program; if not, write to the Free Software 

Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 

*/ 

#def ine WORDSIZE 4 
#define BYTESIZE 1 
#define linesize 180 
#define linemeix linesize-1 
#define mpmax linemax 
#define stif 1 
#define stwhile 2 
#define streturn 3 
#define stbreak 4 
#define stcont 5 
#define stasm 6 
#define stexp 7 
#define stfor 9 
#define stdo 10 
#define NAMES I ZE 16 
#define NAMEMAX 15 

struct snamenode{ 

[NAMES I ZE] char name; 
*snEimenode next; 
f unc init ; 
func done; 

>; 

struct snamelist{ 
*snamenode 1st; 
* * snEimenode f ront ; 
func init ; 
func done; 
func find; 
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func addm; 
func dump; 

}; 

struct ssyin{ 

[NAMES I ZE] char name; 
int sort ; 
int dfd; 
int offset; 
int type; 
int line; 
*sncimelist nmlst; 
func init ; 
func done ; 

}; 

struct ssymlist-C 
ssym sym; 
*ssymlist next; 

>; 

struct ssymtab-[ 
*ssymlist 1st; 
**ssymlist front; 

}; 

var extern glbsymtab,locsymtab:ssymtab; 

#define S_FUNC 1 
#define S_VARG 2 
#define S_VARL 3 
#define T_INT 1 
#define T_CHAR 2 
#define T_INTP 3 
#define T_CHARP 5 

#def ine F_TYPE 6 /*first user-defined type*/ 



#define NUMTYP 50 
#define MAXTYP 49 
#define TYPNMTBS 800 
#define V_PTR 1 
#define V_ARR 2 
#define V_STR 3 
#define V_FND 4 
#define V_FNC 5 
struct styp-[ 

[NAMES I ZE] char name; 

int sort; 

int type; 

int dim; 

int size; 

int ptr; 

>; 
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#define NMSTRELE 50 
/*#define STRNMTBS 800*/ 
struct sfield{ 

[NAMESIZE] char name; 

int type; 

int offset; 

int next ; 

>; 

#define litstksz 30000 
#define litstknu 15 

#define STSIZE 8000 
#define STMAX 7999 

#define WQNUM 75 
#define WQMAX 74 



/* the expression processing */ 



#def ine 


OP. 


.LEAF 





#def ine 


DP. 


.COMMA 


1 


#def ine 


OP. 


.ASSIGN 


2 


#def ine 


OP. 


.COND 


3 


#def ine 


DP. 


.LDR 


4 


#def ine 


OP. 


.LAND 


5 


#def ine 


OP. 


.BOR 


6 


#def ine 


DP. 


.BXDR 


7 


#def ine 


OP. 


.BAND 


8 


#def ine 


OP. 


.EQ 


9 


#def ine 


DP. 


.NEQ 


10 


#def ine 


OP. 


.LE 


11 


#def ine 


OP. 


.GE 


12 


#def ine 


DP. 


.LT 


13 


#def ine 


OP. 


.GT 


14 


#def ine 


OP. 


.SHL 


15 


#def ine 


DP. 


.SHR 


16 


#def ine 


OP. 


.PLUS 


17 


#def ine 


OP. 


.MINUS 


18 


#def ine 


DP. 


.MUL 


19 


#def ine 


OP. 


.DIV 


20 


#def ine 


OP. 


.REM 


21 


#def ine 


DP. 


.IPP 


22 


#def ine 


OP. 


.IMM 


24 


#def ine 


OP. 


.UPLUS 


25 


#def ine 


DP. 


.UMINUS 


26 


#def ine 


OP. 


.STAR 


27 


#def ine 


OP. 


.ADDR 


28 
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#def ine 


OP. 


.LNOT 


29 


#def ine 


OP. 


.BNOT 


30 


#def ine 


OP. 


.2PP 


31 


#def ine 


OP. 


.2MM 


32 


#def ine 


OP. 


.SQ 


33 


#def ine 


OP. 


.FUNC 


34 


#def ine 


OP. 


.DOT 


35 


#def ine 


OP. 


.LIST 


36 



#define L_NUM 1 
#define L_ID 2 
#define L_STR 3 

/* pointed by "/.eax */ 
#define L_POI 4 
/* pointed by (Zesp) */ 
#define L_SP 5 
/* on "/oeax */ 
#define L_ONREG 5 
struct eleaf{ 
int vid; 

int val;/* number or index in the symbol table*/ 
*ssyin idx; 

}; 

struct enode-[ 
*enode 1; 
*enode r; 
*enode third; 
int op ; 
eleaf leaf; 
[NAMES I ZE] char name; 

}; 

struct elval{ 

int sort; /* object, number, string -> L_ID,L_NUM,L_STR*/ 
*ssym idx; /* index in the sjrmbol table, if object */ 
int offset; /*offset in a compound object */ 
int typ; /* type */ 
int val; 

[NAMES I ZE] char name; 

>; 

/♦return value: 0: on register, 1: not on register */ 

var extern *char : graphname ; 

var extern stderr,stdin,stdout:*int; 

2.5 codegen.he 

/* -*- c -*- */ 

/* code generation header by E.V., (C) 2003 */ 



120 



/* 

This program is free software; you can redistribute it and/or modify 
it under the terms of the GNU General Public License as published by 
the Free Software Foundation; either version 2 of the License, or 
(at your option) any later version. 

This program is distributed in the hope that it will be useful, 
but WITHOUT ANY WARRANTY; without even the implied warranty of 
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 
GNU General Public License for more details. 

You should have received a copy of the GNU General Public License 

along with this program; if not, write to the Free Software 

Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 

*/ 



#def ine 


CD. 


.MODSTK 


10 


/* 


add(or subtract) a number to (from) Zesp */ 


#def ine 


CD. 


.STKENTER 


11 


/* 


new stack frame */ 


#def ine 


CD. 


.STKLEAVE 


12 


/* 


leave stack frgime */ 


#def ine 


CD. 


.INCREG 


13 


/* 


increase reg */ 


#def ine 


CD. 


.DECREG 


14 


/* 


decrease reg */ 


#def ine 


CD. 


.ADD2REGS 


15 


/* 


addition */ 


#def ine 


CD. 


.SUB2REGS 


16 


/* 


subtraction */ 


#def ine 


CD. 


.BAND2REGS 


17 


/* 


bitwise AND */ 


#def ine 


CD. 


.B0R2REGS 


18 


/* 


bitwise OR */ 


#def ine 


CD. 


.BX0R2REGS 


19 


/* 


bitwise XOR */ 


#def ine 


CD. 


.SHL 


20 


/* 


« */ 


#def ine 


CD. 


.SHR 


21 


/* 


» unsigned */ 


#def ine 


CD. 


.ASR 


22 


/* 


» signed */ 


#def ine 


CD. 


.EQ 


23 


/* 


== */ 


#def ine 


CD. 


.NEQ 


24 


/* 


!= */ 


#def ine 


CD. 


.ZGE 


25 


/* 


>= signed */ 


#def ine 


CD. 


.UGE 


26 


/* 


>= unsigned */ 


#def ine 


CD. 


.ZLE 


27 


/* 


<= signed */ 


#def ine 


CD. 


.ULE 


28 


/* 


<= unsigned */ 


#def ine 


CD. 


.ZLT 


29 


/* 


< signed */ 


#def ine 


CD. 


.ULT 


30 


/* 


< unsigned */ 


#def ine 


CD. 


.ZGT 


31 


/* 


> signed */ 


#def ine 


CD. 


.UGT 


32 


/* 


> unsigned */ 


#def ine 


CD. 


.BNOT 


33 


/* 


bitwise */ 


#def ine 


CD. 


.LNOT 


34 


/* 


! logical */ 


#def ine 


CD. 


.NEG 


35 


/* 


- unary */ 


#def ine 


CD. 


.TESTNEJUMP 36 /* */ 


#def ine 


CD. 


.ZCALL 


37 


/* 


call */ 


#def ine 


CD. 


.LAB 


38 


/* 


label */ 


#def ine 


CD. 


.MUL2REGS 


39 






#def ine 


CD. 


.DIV2REGS 


40 






#def ine 


CD. 


.MULREG 


41 


/* multiply register by const */ 


#def ine 


CD. 


.DIVCONST 


42 /* divide by const*/ 


#def ine 


CD. 


.IGNORE 


43 
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#def ine 


CD. 


.M0D2REGS 


44 


#def ine 


CD. 


.PUSH 


45 


#def ine 


CD. 


.POP 


46 


#def ine 


CD. 


.RET 


47 


#def ine 


CD. 


.JUMP 


48 


#def ine 


CD. 


.LDLIT 


49 


#def ine 


CD. 


.LDN 


50 


#def ine 


CD. 


.LDA 


51 


#def ine 


CD. 


.LEA 


52 


#def ine 


CD. 


.STOW 


53 


#def ine 


CD. 


.STDB 


54 


#def ine 


CD. 


.STLW 


55 


#def ine 


CD. 


.STLB 


56 


#def ine 


CD. 


.LBRW 


57 


#def ine 


CD. 


.LBRB 


58 


#def ine 


CD. 


.LBRA 


59 


#def ine 


CD. 


.LDW 


60 


#def ine 


CD. 


.LDB 


61 


#def ine 


CD. 


.LDLW 


62 


#def ine 


CD. 


.LDLB 


63 


#def ine 


CD. 


.ST0W2 


64 


#def ine 


CD. 


.ST0B2 


65 


#def ine 


CD. 


.TEST JUMP 


66 /* */ 



struct scode 
{ 

int code; 
int arg ; 
int reg; 
*char str; 

>; 

#define NCODEITEMS 150 

struct scodegen 

{ 

int ncodeitems ; 
int codeptr; 
*scode codes; 

}; 

func cg_init (this : *scodegen) ; 
f unc cg_done (this : *scodegen) ; 
func cg_getitein(this :*scodegen); 
func cd_init (code : *scode) ; 
func cg_print (this : *scodegen) ; 

#define RG_A 
#define RG_B 1 
#define RG_C 2 



#define RG_D 3 

func icodegenO ; 

func dcodegenO ; 

var **char extern: regnaunes; 

var extern *scodegen: ccg; 

var extern scodegen: cgglb; 

var extern int :Zsp; 

2.6 autodyn.e 

/* -*- c -*- */ 

/* Automatic allocation/deallocation by E.V., (C) 2003 */ 

/* 

This program is free software; you can redistribute it and/or modify 
it under the terms of the GNU General Public License as published by 
the Free Software Foundation; either version 2 of the License, or 
(at your option) any later version. 

This program is distributed in the hope that it will be useful, 
but WITHOUT ANY WARRANTY; without even the implied warranty of 
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 
GNU General Public License for more details. 

You should have received a copy of the GNU General Public License 

along with this program; if not, write to the Free Software 

Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 

*/ 

#define _DYNSIZE 100 
var int : _dynsize ; 
var **char: _dyn_ptr; 
var int : _dynw ; 
func chkmemO ; 
func initdynO 
{ 

_dynsize=_DYNSIZE; 

chkmem (_dyn_ptr=calloc (_dynsize , sizeof (*char) ) ) ; 
_dynw=0 ; 

} 

func dyncalloc(int:nmemb,int:size) 
{ 

if (_dynw>=_dynsize) 
i 

_dynsize=_dynsize+_DYNSIZE; 

chkmem (_dyn_ptr=realloc (_dyn_ptr , _dynsize*sizeof (*char) ) ) ; 

> 

return _dyn_ptr [_dynw++]=chkmem(calloc(nmemb,size)) ; 

} 

func autodynstr(*char :s) 
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{ 

var int :1; 
var *char:res; 
l=strlen(s) ; 

res=dyncalloc (1+1 , sizeof (char) ) ; 
strcp(res , s) ; 
return res; 

> 

var extern *int: stderr; 

func donedynO 

{ 

if (_dyn_ptr) 
i 

var int : i ; 
i=_dynw; 
while (i) 
{ 

f ree (_dyn_ptr [ — i] ) ; 

/♦fprintf (stderr , "freed [7.d] =°/.d\n" , i , _dyn_ptr [i] ) ; */ 

> 

f ree(_dyn_ptr) ; 

} 



2.7 Ippl.e 

/* -*- c -*- * 

This is the preprocessor 

/* 

This prograjn is free software; you can redistribute it and/or modify 
it under the terms of the GNU General Public License as published by 
the Free Software Foundation; either version 2 of the License, or 
(at your option) any later version. 

This program is distributed in the hope that it will be useful, 

but WITHOUT ANY WARRANTY; without even the implied warranty of 
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 
GNU General Public License for more details. 

You should have received a copy of the GNU General Public License 
along with this program; if not, write to the Free Software 
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 U 

*/ 

#define MAXINC 10 

var extern stderr, stdin,stdout:*int; 

var if il , of il : *int ; 

var ifiles: [MAXINC] *int; 

var iptr:int; 
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var line.rline: [160] char; 
var Iptr , rlptr : int ; 
var isinp, iseof : int ; 
var strpool : [3000] char ; 
var strptr : int ; 

struct cmac-C*char n; *char sub;}; 

var mactab: [200] cmac; 

var macptr : int ; 

func strep (d:*char,s:*char) 

{ 

while (*d++=*s++) ; 

} 

func ch() 
{ 

return line [Iptr] ; 

} 

func gch() 
{ 

return line [lptr++] ; 

} 

func putres (c : int) 
{ 

if (rlptr>=159) 

{error ("output buffer overflow") ; return O;} 
return rline[rlptr++]=c; 

} 

func putmac (c : int) 
{ 

/*f printf (stderr , "putmac : c=°/,d\n" , c) ; */ 
if (strptr>=2999) 

-[error (" string pool full") ;return 0;> 
return strpool [strptr++] =c ; 

} 

func getnewstrO 
{ 

if (strptr>=2999) 

-[error ("getnewstr: string pool full") ; return 0;} 
return strptr; 

} 

func addmacO 

{ 

var [16] char : sname ; 

var int : k , 1 ; 

if ( ! symname (snaime) ) 

{error("wrong macro name") ; return; }- 

if (macptr>=199) 

{error ("mactab full") ; return;} 
sbO ; 

k=getnewstr() ; 



125 



mactab[macptr] .n=strpool+k; 

1=0; 

while (putmac (sname [1++] ) ) 

k=getnewstr ; 

mactab [macptr] . sub=strpool+k; 
while (putmac (line [lptr++] ) ) ; 

/*fpriiitf (stderr, "macro name=7.s, sub=7.s\n" , mactab [macptr] .n, 

mactab [macptr] . sub) ; */ 
macptr++ ; 

> 

func strid(strl:*char,str2:*chcir) 
{ 

var int : k ; 
k=0; 

while (str2 [k] ) 

{if (strl [k] !=str2[k] ) return 0;k++;} 
if (strl[k]) return 0; 
return 1; 

} 

func f indmac(s : *char) 
{ 

var int : i ; 

f or (i=l ; Kmacptr ; i++) 

if (strid(s, mactab [i] .n)) 

return i; 
return 0; 

} 

func symname (sname:* char) 
{ 

var int : k , 1 ; var char : c ; 

sbO ; 

if (! alpha (line [Iptr] )) return 0; 
for(k=l=0;an(line[lptr]) ;) 
i 

if (k<15) 

{sname [1++] =line [lptr++] ; k++ ; } 

else 

{k++;lptr++;> 

> 

snEime [1] =0; 
return 1 ; 

} 

func amatch(lit : *char,len: int) 
{ 

var int : k ; 
sbO; 

if (k=astreq(line+lptr,lit,len) ) 
{ 
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lptr=lptr+k; 
return 1; 

} 

return 0; 

> 

func error (p:*char) 
{ 

fprintf (stderr, Error :7.s\nline :7.s\n" ,p, line) ; 

} 

func cin(c:int) 
{ 

return ( (alpha(c) ) I I (numeric (c) ) ) ; 

} 

func numeric (c : int) 
{ 

return((c>='0')&&(c<='9')) ; 

} 

func alphaCc : int) 
{ 

return (((c>='a')&&(c<='z')) I I ((c>='A')&&(c<='Z')) I I (c=='_')) ; 

} 

func inslineO 
{ 

var int : k ; 

if ( ! isinp) iseof =1 ; 

if (iseof )return; 

lptr=0 ; 

line [0] =0; 

while ( (k=f getc (if il) ) >0) 
i 

if ((k==10) I I (lptr>=158)) 
{break; } 
line[lptr++] =k; 

> 

line [Iptr] =0; 

if (k<0) 

i 

if (iptr>0) 
i 

f close(if il) ; 
ifil=ifiles[ — iptr] ; 

} 

else 
isinp=0; 

} 

/*f printf (stderr , "«««°/.s\n" , line) ; */ 

} 

func isb(c:int) 
{ 
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return (line [Iptr] ==32) | | (line [Iptr] ==9) | | 
(line[lptr] ==10) ; 

} 

func sb() 
{ 

while ((line [Iptr] ==32) | | (line [Iptr] ==9) | | 

(line [Iptr] ==10)) 
lptr++ ; 

} 

func match (lit :* char) 
{ 

var int : k ; 
sbO; 

if (k=streq(line+lptr,lit)) 
{lptr=lptr+k; return 1;} 
return 0; 

} 

func streq(strl:*char,str2:*char) 
{ 

var int : k ; 

for (k=0 ; str2 [k] ; k++) 

if (strl[k] !=str2[k]) return 0; 

return k; 

} 

func astreq(strl : *char, str2: *char ,len: int) 
{ 

var int : k ; 
k=0; 

while (k<len) 
i 

if ((strl[k]) !=(str2[k]))break; 
if (!strl[k])break; 
if (!str2 [k]) break; 
k++; 

} 

if (an (strl [k] )) return 0; 
if (an(str2[k] ))return 0; 
return k; 

} 

func prepO 
{ 

rline [0]=0; 
rlptr=0; 
lptr=0; 
lptr=0 ; 

while (line [Iptr] ) 
i 

var [16] char : sname ; 
var int : k ; 
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if (isbCline [Iptr])) 

{putresC ');lptr++;} 
else if (syinname(sname)) 
{ 

if ( k=f indmac ( sname ) ) 
{ 

var *char:p; 
p=mactab[k] .sub; 

/*fprintf (stderr , " substituting :°/,s\n" ,p) ; */ 
while (*p)putres(*p++) ; 

} 

else 
{ 

k=0; 

while (sname [k] )putres (sname [k++] ) ; 

} 

> 

else if (line [Iptr] ==39) 
{ 

putres(gch()) ; 
while (ch() !=39) 
{ 

if (IchO) 

{error ("unterminated char const") ;break;;} 
else if (ch()=='\\') 

{ 

putres(gch()) ; 
if (IchO) 
{ 

if (iseof ) 
break ; 
inslineO ; 
lptr=0 ; 

} 

else putres(gch()) ; 

} 

else putres(gch() ) ; 

} 

if (ch()==39) 
putres(gch()) ; 

> 

else if (line [Iptr] == ) 
{ 

/* f printf (stderr , "quoted string=°/oS\n" , line+lptr) ; */ 

putres(gch()) ; 
while(ch() !='"') 
{ 

if (IchO) 

{error ("unterminated string") ; break;} 
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else if (ch()=='\\') 
{ 

putresCgchO) ; 
if (IchO) 
{ 

if (iseof ) 
break ; 
insline ; 
lptr=0 ; 

} 

else putresCgchO) ; 

} 

else putresCgchO); 

} 

if ( ch ()=="" ) putres (gch ( ) ) ; 

} 

else if ( (line [Iptr] =='/')&& (line [lptr+1] =='*')) 
i 

lptr=lptr+2 ; 

while (!(( ch ()=='*')&&( line [lptr+1] =='/'))) 
{ 

ifdchO) 

{ 

if (iseof) 
break ; 
insline ; 
lptr=0; 

> 

else 
gchO; 

} 

if ((ch()=='*')&&(line[lptr+l]=='/')) 
lptr=lptr+2; 

} 

else putres (gch() ) ; 

} 

putres (0) ; 
strcpdine.rline) ; 
lptr=0 ; 

if (amatch("#define",7)) 
< 

addmac ; 
rline [0] =0; 

} 

else if (lptr=0 , amat ch ( " #include " , 8) ) 
i 

doinclude ; 
rline [0]=0; 
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func doincludeO 
{ 

var [160] char :newn; 
var int:k,c; 
var int :delim; 
sbO; 

if (ch( )=="") {delim=' "' ;gch() ;} 
else if (ch ()=='<' ){delim='>' ;gch();} 
else delim=0; 

for (k=0 ; k<159&&ch ( ) && ! isblank (ch ( ) ) &&ch ( ) ! =delim ; k++) 
i 

if (ch()==92) 
{ 

gchO; 

if (!ch())break; 
c=gch() ; 
if (c=='nOc=10; 
else if (c=='t')c=9; 
else if (c=='b')c=8; 
else if (c=='f ')c=12; 
newn [k] =c ; 

> 

else 
{ 

c=gch() ; 
newn[k]=c; 

} 

} 

newn [k] =0 ; 

/*fprintf (stderr , "new name :7.s\n" , newn) ;*/ 

if (iptr>=MAXlNC-2) 

errorC'too many nested #include"); 

else 

i 

++iptr ; 

if ( ! (if iles [iptr] =ifil=f open (newn, "r") ) ) 
{ 

error ("error opening 7os\n" ,newn) ; 
ifil=ifiles[ — iptr] ; 

} 

} 

} 

func process 
{ 

while ( ! iseof ) 
i 

inslineO ; 
prepO ; 
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fputsCrline.of il) ;fputc(10,of il) ; 

} 

} 

f unc main ( ar gc : int , ar gv : * * char ) 
{ 

var int : i , is_out , is_in; 
var * char : outn , inn ; 
strptr=0 ; 
niacptr=l ; 
iseof =0; 
isinp=l ; 
is_in=is_out=0 ; 
outn=0 ; 
inn=0 ; 
iptr=0 ; 

f or (i=l ; i<argc ; i++) 
{ 

if ( ! is_in) 

-[inn=argv [i] ; is_in=l ; } 
else if(!is_out) 
■[outn=argv [i] ; is_out=l ; } 

} 

if (inn) 
i 

if (! (ifil=fopen(inn,"r"))) 
{fprintf (stderr, "err in") ;exit(l) ;} 

> 

else 

if il=stdin; 
if (outn) 
i 

if ( ! (of il=f open(outn, "w"))) 
{fprintf (stderr, "err out") ;exit(l) ;} 

} 

else 

of il=stdout ; 
ifiles[0]=ifil; 
var int : c ; 
process ; 

if (inn)f close(if il) ; 
if (outn)f close(of il) ; 
return 0; 



2.8 langdrv.pl 

# ! /usr/bin/perl 
use File: :Basename; 
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$LPP=' ./ippl' ; 
$LAMGC=' ./langc' ; 
$outname= ' a . out ' ; 
$numArgs=$#ARGV+l ; 

QenELines=() ; 
(9sncimes=() ; 

print "number of arguments : $numArgs\n" ; 
f or ($i=0 ; $i<$numArgs ; $i++) 
i 

print "\$ARGV [$i] =$ARGV [$i] \n" ; 
if($ARGV[$i] eq '-o') 
{ 

if ($i>=$numArgs-l) 

{ 

print "ending with \"-o\"\n"; 
exit 1; 

} 

$outname=$ARGV[$i+l] ; 
$i+=l; 

} 

else 
{ 

push((§enames,$ARGV[$i] ) ; 

($xname,$xpath,$xsuff ix)=f ileparse($ARGV[$i] , '\. .*') ; 

print "\$xname=$xnaine , \$xpath=$xpath, \$xsuf f ix=$xsuf f ix, \n"; 

$tsname=$xpath . Sxncune . '.s'; 

print "\$tsname=$tsncime\n" ; 

push(@snames,$tsname) ; 

} 

> 

print("\$0=$0\n") ; 
print "\@enames=@enames\n" ; 
print "\Qsncimes=Qsncimes\n" ; 
print "\$outname=$outname\n" ; 
#$tt= loutname . "asdf\n"; 
#print $tt; 
$nf iles=$#enames+l ; 
print "$nfiles files to compile\n"; 
f or($i=G;$i<$nf iles;$i++) 
< 

$thecmd="$LPP $enames[$i] I $LAMGC > $snames [$i] " ; 
print $thecind . "\n"; 
'$thecmd' ; 
> 

$slist="Qsnaines" ; 

print $slist . "\n"; 

$newcmd="gcc -o $outnEime Ssnames "; 

print $newcmd . "\n"; 

' $newcmd ' ; 
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